Introducción.

En este proyecto, se analizarán los resultados del mundial de natación de 2015 con el objetivo de identificar patrones en el desempeño de los nadadores por país y eventos. Se realizará un análisis exploratorio de datos y se utilizarán técnicas de reducción de dimensionalidad, aprendizaje no supervisado, aprendizaje supervisado, medidas de rendimiento, comparación de modelos y técnicas de Aprendizaje Máquina Explicable.

En primer lugar, veamos con qué datos vamos a tratar. El conjunto de datos consiste en los resultados del Campeonato Mundial de Natación Kazán del año 2015, con los correspondientes datos de cada nadador y prueba. Los datos han sido extraídos de Omega, la plataforma oficial de tiempos de la World Aquatics. El conjunto de datos contiene información sobre los nadadores (fecha de nacimiento, país, id), y sobre la prueba nadada (tiempo de reacción, parciales, tiempo total, estilo, serie).

Las variables o atributos que conforman el conjunto de datos son:

  • athleteid: id del nadador
  • lastname: Apellidos del nadador
  • firstname: El nombre del nadador
  • birthdate: Fecha de nacimiento del nadador
  • gender: Género del nadador/a
  • name: Nombre del país
  • code: abreviatura del país.
  • eventid: id de la prueba nadada (único)
  • heat: Serie en la que nadaron
  • lane: Calle en la que nadaron (0 a 9)
  • points: puntos FINA que realizaron. (es una “estimación” entre el mejor tiempo o récord del mundo, y el tiempo realizado. )
  • reactiontime: Tiempo de reacción en la salida.
  • swimtime: tiempo tardado
  • split: Parcial
  • cumswimtime: Tiempo acumulado en el parcial
  • splitdistance: Distancia del parcial
  • daytime: hora a la que se nadó
  • round: ronda (preliminar, semifinal, final)
  • distance: distancia de la prueba
  • relaycount: Número de relevista.
  • stroke: Estilo de nado en el que se realizó la prueba.
  • splitswimtime: Tiempo del parcial (50m)

Entender los datos.

Primeramente, vamos a leer los datos:

datos2015<-read.csv("datos/2015_FINA.csv", header=TRUE, sep = ',')

Una vez nuestro programa los ha leído, vamos a averiguar el tamaño de los datos con los que vamos a tratar:

dim(datos2015)
## [1] 11423    22

Las dimensiones del dataframe son 11423 filas y 22 variables o columnas.

Veamos la primera ocurrencia:

head(datos2015,1)
##   athleteid lastname firstname  birthdate gender    name code eventid heat lane
## 1    100784   BORSHI      NOEL 1996-02-13      F Albania  ALB       1    1    4
##   points reactiontime swimtime split cumswimtime splitdistance daytime round
## 1    680         0.77    63.65     1       29.63            50     930   PRE
##   distance relaycount stroke splitswimtime
## 1      100          1    FLY         29.63

Observamos Noel Borshi, nadadora albanesa nacida un 13 de febrero de 1996, que tiene como id el número (100784). Noel Borshi nadó la prueba 1 en la serie 1 y carril 4. Nadó el 100m Mariposa en la ronda preliminar con un tiempo final de 63.65 segundos y pasó por el primer parcial (50m) en 29.63 segundos.

Análisis exploratorio de datos.

Resumen de los datos.

A continuación, vamos a ver un resumen de los datos:

summary(datos2015)
##    athleteid        lastname          firstname          birthdate        
##  Min.   :100392   Length:11423       Length:11423       Length:11423      
##  1st Qu.:101501   Class :character   Class :character   Class :character  
##  Median :103266   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :106980                                                           
##  3rd Qu.:110718                                                           
##  Max.   :125573                                                           
##                                                                           
##     gender              name               code              eventid      
##  Length:11423       Length:11423       Length:11423       Min.   :  1.00  
##  Class :character   Class :character   Class :character   1st Qu.: 13.00  
##  Mode  :character   Mode  :character   Mode  :character   Median : 30.00  
##                                                           Mean   : 53.15  
##                                                           3rd Qu.: 39.00  
##                                                           Max.   :428.00  
##                                                                           
##       heat            lane           points        reactiontime   
##  Min.   : 1.00   Min.   :0.000   Min.   :  52.0   Min.   :0.4200  
##  1st Qu.: 1.00   1st Qu.:2.000   1st Qu.: 783.0   1st Qu.:0.6800  
##  Median : 3.00   Median :4.000   Median : 853.0   Median :0.7200  
##  Mean   : 3.08   Mean   :4.485   Mean   : 826.6   Mean   :0.7205  
##  3rd Qu.: 4.00   3rd Qu.:7.000   3rd Qu.: 902.0   3rd Qu.:0.7600  
##  Max.   :12.00   Max.   :9.000   Max.   :1028.0   Max.   :0.9700  
##                                  NA's   :71       NA's   :61      
##     swimtime           split         cumswimtime      splitdistance   
##  Min.   :  21.19   Min.   : 1.000   Min.   :  21.19   Min.   :  50.0  
##  1st Qu.: 114.10   1st Qu.: 1.000   1st Qu.:  49.45   1st Qu.:  50.0  
##  Median : 231.31   Median : 3.000   Median :  99.36   Median : 150.0  
##  Mean   : 366.11   Mean   : 6.296   Mean   : 197.01   Mean   : 314.8  
##  3rd Qu.: 523.24   3rd Qu.: 8.000   3rd Qu.: 255.23   3rd Qu.: 400.0  
##  Max.   :1137.27   Max.   :30.000   Max.   :1137.27   Max.   :1500.0  
##  NA's   :59                         NA's   :59                        
##     daytime        round              distance        relaycount
##  Min.   : 930   Length:11423       Min.   :  50.0   Min.   :1   
##  1st Qu.:1000   Class :character   1st Qu.: 200.0   1st Qu.:1   
##  Median :1048   Mode  :character   Median : 400.0   Median :1   
##  Mean   :1192                      Mean   : 580.5   Mean   :1   
##  3rd Qu.:1117                      3rd Qu.: 800.0   3rd Qu.:1   
##  Max.   :1943                      Max.   :1500.0   Max.   :1   
##                                                                 
##     stroke          splitswimtime   
##  Length:11423       Min.   : 21.19  
##  Class :character   1st Qu.: 29.10  
##  Mode  :character   Median : 30.82  
##                     Mean   : 31.02  
##                     3rd Qu.: 32.77  
##                     Max.   :101.02  
##                     NA's   :59

De aquí, podemos observar que tenemos algunos valores nulos (NA’s), durante toda la competición, que como máximo hubo 12 series y como mínimo 1 y que la piscina disponía de 10 carriles numerados del 0 al 9. También observamos que se nadaron pruebas de 50 y hasta 1500 metros.

Tenemos variables categóricas las cuales se han tratado como continuas de partida. Por lo cual, usando la librería “dyplr”, vamos a convertirlas a variables categóricas en R para tener una mejor visualización de ellas.

datos2015<- datos2015 %>% convert_as_factor(gender,name,code,round,heat,lane,stroke, relaycount)

Visualicemos ahora de nuevo el resumen:

summary(datos2015)
##    athleteid        lastname          firstname          birthdate        
##  Min.   :100392   Length:11423       Length:11423       Length:11423      
##  1st Qu.:101501   Class :character   Class :character   Class :character  
##  Median :103266   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :106980                                                           
##  3rd Qu.:110718                                                           
##  Max.   :125573                                                           
##                                                                           
##  gender              name           code         eventid            heat     
##  F:5236   United States: 755   USA    : 755   Min.   :  1.00   1      :3181  
##  M:6187   China        : 507   CHN    : 507   1st Qu.: 13.00   2      :2297  
##           Australia    : 479   AUS    : 479   Median : 30.00   3      :1838  
##           Great Britain: 462   GBR    : 462   Mean   : 53.15   4      :1561  
##           Germany      : 411   GER    : 411   3rd Qu.: 39.00   5      :1317  
##           Italy        : 382   ITA    : 382   Max.   :428.00   6      : 439  
##           (Other)      :8427   (Other):8427                    (Other): 790  
##       lane          points        reactiontime       swimtime      
##  4      :1303   Min.   :  52.0   Min.   :0.4200   Min.   :  21.19  
##  6      :1269   1st Qu.: 783.0   1st Qu.:0.6800   1st Qu.: 114.10  
##  5      :1247   Median : 853.0   Median :0.7200   Median : 231.31  
##  2      :1246   Mean   : 826.6   Mean   :0.7205   Mean   : 366.11  
##  3      :1215   3rd Qu.: 902.0   3rd Qu.:0.7600   3rd Qu.: 523.24  
##  7      :1202   Max.   :1028.0   Max.   :0.9700   Max.   :1137.27  
##  (Other):3941   NA's   :71       NA's   :61       NA's   :59       
##      split         cumswimtime      splitdistance       daytime     round     
##  Min.   : 1.000   Min.   :  21.19   Min.   :  50.0   Min.   : 930   FIN:1475  
##  1st Qu.: 1.000   1st Qu.:  49.45   1st Qu.:  50.0   1st Qu.:1000   PRE:8904  
##  Median : 3.000   Median :  99.36   Median : 150.0   Median :1048   SEM:1022  
##  Mean   : 6.296   Mean   : 197.01   Mean   : 314.8   Mean   :1192   SOP:   4  
##  3rd Qu.: 8.000   3rd Qu.: 255.23   3rd Qu.: 400.0   3rd Qu.:1117   SOS:  18  
##  Max.   :30.000   Max.   :1137.27   Max.   :1500.0   Max.   :1943             
##                   NA's   :59                                                  
##     distance      relaycount    stroke     splitswimtime   
##  Min.   :  50.0   1:11423    BACK  :1053   Min.   : 21.19  
##  1st Qu.: 200.0              BREAST:1205   1st Qu.: 29.10  
##  Median : 400.0              FLY   :1095   Median : 30.82  
##  Mean   : 580.5              FREE  :6782   Mean   : 31.02  
##  3rd Qu.: 800.0              MEDLEY:1288   3rd Qu.: 32.77  
##  Max.   :1500.0                            Max.   :101.02  
##                                            NA's   :59

Viendo este resumen de los datos podemos comenzar a entender algunas de las variables.

Observamos que las variables name y code toman absolutamente los mismos valores. Se trata del país de procedencia de cada nadador.

Vemos que hay 5 tipos de nado: braza, mariposa, crol, espalda y estilos individual.

No hemos guardado la distancia como una variable categórica, pero más adelante veremos que hay 6 distancias (50, 100, 200, 400, 800, 1500). Hay 5 tipos de ronda distintos.

El menor tiempo de reacción fue de 0.42 y el mayor de 0.97.

Viendo los datos, observamos que cada nadador tiene en una prueba concreta, tantas filas como parciales tenía en esa prueba, luego es obvio que para conocer mejor algunas variables, vamos a necesitar limpiar los datos para que los elementos repetidos no causen interferencia en nuestros datos.

A continuación, vamos a ir realizando estudios para tratar de comprender más a fondo algunas variables.

Variable Relaycount.

Si observamos el resumen de la variable relaycount:

summary(datos2015$relaycount)
##     1 
## 11423

Observamos que sólo toma un único valor, 1. Esto se debe principalmente a que nuestro conjunto de datos consta de las pruebas individuales del mundial de Kazán 2015, luego como no hay relevos, todos los nadadores son el primer “relevista” en su prueba.

Luego, la eliminamos:

datos2015$relaycount <- NULL

Luego ahora, tenemos 21 variables en vez de 22.

Valores NA. Datos faltantes.

Si volvemos a mirar nuestro resumen, observamos que hay valores faltantes. Vamos a tratar de identificarlos, intentar entender el por qué de esos datos faltantes, y razonar cuándo será conveniente eliminarlos o no de nuestro estudio.

Para ello, vamos a obtener primeramente un resumen de cuántos datos faltantes hay:

print(sum(is.na(datos2015)))
## [1] 309

Observamos que hay 309 valores faltantes.

Vamos a crear una dataframe donde se nos muestren dónde se encuentran los valores faltantes:

datosNA <- datos2015[rowSums(is.na(datos2015)) > 0, ]
dim(datosNA)
## [1] 73 21

Observamos que, de 11429 observaciones de mi dataframe original, en 73 de ellas, existe algún valor nulo. Es decir, un 0.63 % por ciento. Lo cual es un valor muy bajo.

En principio y sin estudiar nada más, podríamos considerar eliminar las filas que contengan datos faltantes ya que toman un valor muy pequeño con respecto al total. Aún así, vamos a ver dónde se suelen tomar más valores nulos e intentar explicar el por qué. Hacemos una dataframe adicional con los valores nulos de cada variable en porcentaje:

percent_na <- colSums(is.na(datosNA)) / nrow(datosNA) * 100
percent_na
##     athleteid      lastname     firstname     birthdate        gender 
##       0.00000       0.00000       0.00000       0.00000       0.00000 
##          name          code       eventid          heat          lane 
##       0.00000       0.00000       0.00000       0.00000       0.00000 
##        points  reactiontime      swimtime         split   cumswimtime 
##      97.26027      83.56164      80.82192       0.00000      80.82192 
## splitdistance       daytime         round      distance        stroke 
##       0.00000       0.00000       0.00000       0.00000       0.00000 
## splitswimtime 
##      80.82192

Observamos de manera bastante clara que los datos nulos tienen mucho que ver con el tiempo acumulado, los puntos finales, el tiempo de reacción, el tiempo final y el tiempo al paso por el parcial.

A continuación, vamos a intentar clasificar los nulos dependiendo qué falta:

Valores nulos en los que faltan todas las variables.

Visualicemos los datos donde faltan todas las variables dichas anteriormente:

todosNA<-datosNA[is.na(datosNA$points) & is.na(datosNA$reactiontime) & is.na(datosNA$swimtime) & is.na(datosNA$cumswimtime) & is.na(datosNA$splitswimtime), ]

dim(todosNA)
## [1] 59 21

Bien, en 59 de las 73 observaciones, faltan, tanto el tiempo de reacción, los puntos finales, el tiempo final, los parciales acumulados… Es decir, nadadores que posiblemente se dieron de baja en la prueba.

summary(todosNA)
##    athleteid        lastname          firstname          birthdate        
##  Min.   :100433   Length:59          Length:59          Length:59         
##  1st Qu.:101576   Class :character   Class :character   Class :character  
##  Median :102889   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :108266                                                           
##  3rd Qu.:115503                                                           
##  Max.   :122970                                                           
##                                                                           
##  gender       name         code       eventid            heat         lane   
##  F:16   Cameroon: 6   CMR    : 6   Min.   :  1.00   1      :12   3      :14  
##  M:43   Hungary : 6   HUN    : 6   1st Qu.: 18.50   2      :11   8      : 7  
##         Mexico  : 5   MEX    : 5   Median : 28.00   4      :10   9      : 7  
##         Brazil  : 3   BRA    : 3   Mean   : 26.51   5      : 6   0      : 6  
##         Germany : 3   GER    : 3   3rd Qu.: 34.00   3      : 5   4      : 6  
##         Estonia : 2   ESP    : 2   Max.   :138.00   7      : 3   1      : 5  
##         (Other) :34   (Other):34                    (Other):12   (Other):14  
##      points     reactiontime    swimtime       split    cumswimtime 
##  Min.   : NA   Min.   : NA   Min.   : NA   Min.   :1   Min.   : NA  
##  1st Qu.: NA   1st Qu.: NA   1st Qu.: NA   1st Qu.:1   1st Qu.: NA  
##  Median : NA   Median : NA   Median : NA   Median :1   Median : NA  
##  Mean   :NaN   Mean   :NaN   Mean   :NaN   Mean   :1   Mean   :NaN  
##  3rd Qu.: NA   3rd Qu.: NA   3rd Qu.: NA   3rd Qu.:1   3rd Qu.: NA  
##  Max.   : NA   Max.   : NA   Max.   : NA   Max.   :1   Max.   : NA  
##  NA's   :59    NA's   :59    NA's   :59                NA's   :59   
##  splitdistance    daytime       round       distance         stroke  
##  Min.   :50    Min.   : 930.0   FIN: 1   Min.   :  50.0   BACK  : 7  
##  1st Qu.:50    1st Qu.: 930.0   PRE:58   1st Qu.:  50.0   BREAST: 9  
##  Median :50    Median : 949.0   SEM: 0   Median : 100.0   FLY   :11  
##  Mean   :50    Mean   : 997.2   SOP: 0   Mean   : 228.8   FREE  :24  
##  3rd Qu.:50    3rd Qu.:1030.0   SOS: 0   3rd Qu.: 200.0   MEDLEY: 8  
##  Max.   :50    Max.   :1820.0            Max.   :1500.0              
##                                                                      
##  splitswimtime
##  Min.   : NA  
##  1st Qu.: NA  
##  Median : NA  
##  Mean   :NaN  
##  3rd Qu.: NA  
##  Max.   : NA  
##  NA's   :59
todosNA[todosNA$round=="FIN",]
##      athleteid lastname firstname  birthdate gender  name code eventid heat
## 2100    103297      SUN      YANG 1991-12-01      M China  CHN     138    1
##      lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 2100    3     NA           NA       NA     1          NA            50    1820
##      round distance stroke splitswimtime
## 2100   FIN     1500   FREE            NA

La mayoría de nadadores causaron baja en la ronda preliminar, pero hay uno, el nadador chino Sun Yang, que causó baja en la final del 1500m libres masculino.

Haciendo una pequeña búsqueda en los resultados de la World Aquatics de los mundiales de 2015, observamos que Sun Yang produjo DNS (Did not Start).

todosNA[todosNA$firstname=="CESAR",]
##      athleteid    lastname firstname  birthdate gender   name code eventid heat
## 1179    100523 CIELO FILHO     CESAR 1987-01-10      M Brazil  BRA      28   12
##      lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 1179    3     NA           NA       NA     1          NA            50     930
##      round distance stroke splitswimtime
## 1179   PRE       50   FREE            NA

También, buscando a César Cielo en el 50 libres de las preliminares, observamos que causó baja DNS. Para ponernos en contexto, Cesar Cielo es a dia de hoy, el poseedor del récord mundial del 50 libres, luego también resultaba raro que causase baja.

Luego todo parece indicar que estos nadadores fueron baja en esa prueba y por ello no sale ningún dato en esas variables. Vamos a optar por eliminarlos.

#Primero datosNA: 
datosNA <- datosNA %>%
  filter(!(is.na(datosNA$points) & is.na(datosNA$reactiontime) & is.na(datosNA$swimtime) & is.na(datosNA$cumswimtime) & is.na(datosNA$splitswimtime)))

#Ahora, los eliminamos de datos2015: 
datos2015<-datos2015 %>%
  filter(!(is.na(datos2015$points) & is.na(datos2015$reactiontime) & is.na(datos2015$swimtime) & is.na(datos2015$cumswimtime) & is.na(datos2015$splitswimtime)))

Bien, ahora, tenemos solamente datos en los que falta alguna de las variables. Analizamos nuevamente para poder reclasificarlos:

datosNA
##    athleteid      lastname              firstname  birthdate gender
## 1     110900      TREFFERS                    BEN 1991-08-15      M
## 2     121185        SEIBOU                LARAIBA 2000-12-06      F
## 3     101566        NASSIF     CHRISTIAN DJIDAGUI 1994-01-01      M
## 4     111377     SAUVOUREL     CHLOE MARIE HELENE 2000-06-18      F
## 5     108307  BARRERA AIRA                ARMANDO 1995-11-18      M
## 6     108649 KALOPSIDIOTIS                 MARKOS 1991-06-15      M
## 7     125573        MUKTAR       ABDELMALIK TOFIK 1996-04-19      M
## 8     110501        JALLOW                 MIMOSA 1994-06-17      F
## 9     108274        BAQLAH                 TALITA 1995-10-27      F
## 10    102784          HALL                 JOSHUA 1991-04-12      M
## 11    102775       MOROZOV               VLADIMIR 1992-06-16      M
## 12    107019       TYURINA             ANASTASIYA 2001-09-27      F
## 13    107019       TYURINA             ANASTASIYA 2001-09-27      F
## 14    113324      ALSHAMSI ALIA ALI ABDULLA MAJED 2000-05-02      F
##                    name code eventid heat lane points reactiontime swimtime
## 1             Australia  AUS     210    2    8     NA         0.71    54.50
## 2                 Benin  BEN      36    2    7     NA         0.88    47.47
## 3  Central African Rep.  CAF      14    3    0     NA         0.77    47.33
## 4  Central African Rep.  CAF      34    2    8    132           NA    46.55
## 5                  Cuba  CUB      10    3    2     NA         0.57    55.84
## 6                Cyprus  CYP       6    3    1     NA         0.64    67.96
## 7              Ethiopia  ETH      28    4    0     NA         0.79    27.34
## 8               Finland  FIN      18    4    2     NA         0.42    28.18
## 9                Jordan  JOR      34    7    9     NA         0.74    26.53
## 10          Philippines  PHI      14    6    8     NA         0.66    28.37
## 11               Russia  RUS     219    2    5     NA         0.47    48.12
## 12           Tajikistan  TJK      18    1    5    347           NA    38.48
## 13           Tajikistan  TJK      34    2    6     NA         0.80    32.22
## 14 United Arab Emirates  UAE      11    1    9     NA         0.74   101.02
##    split cumswimtime splitdistance daytime round distance stroke splitswimtime
## 1      1       54.50            50    1748   SEM      100   BACK         54.50
## 2      1       47.47            50    1008   PRE       50 BREAST         47.47
## 3      1       47.33            50     930   PRE       50 BREAST         47.33
## 4      1       46.55            50     930   PRE       50   FREE         46.55
## 5      1       55.84            50     949   PRE      100   BACK         55.84
## 6      1       67.96            50    1134   PRE      100 BREAST         67.96
## 7      1       27.34            50     930   PRE       50   FREE         27.34
## 8      1       28.18            50     930   PRE       50   BACK         28.18
## 9      1       26.53            50     930   PRE       50   FREE         26.53
## 10     1       28.37            50     930   PRE       50 BREAST         28.37
## 11     1       48.12            50    1732   SEM      100   FREE         48.12
## 12     1       38.48            50     930   PRE       50   BACK         38.48
## 13     1       32.22            50     930   PRE       50   FREE         32.22
## 14     1      101.02            50    1007   PRE      100 BREAST        101.02

Nos quedan solamente 14 filas en los que hay datos nulos.

Si seguimos con nuestra limpieza:

Valores nulos donde faltan los puntos:

Veamos qué sucede si sólo faltan los puntos:

naReactionTime<-datosNA[is.na(datosNA$points),]
naReactionTime
##    athleteid      lastname              firstname  birthdate gender
## 1     110900      TREFFERS                    BEN 1991-08-15      M
## 2     121185        SEIBOU                LARAIBA 2000-12-06      F
## 3     101566        NASSIF     CHRISTIAN DJIDAGUI 1994-01-01      M
## 5     108307  BARRERA AIRA                ARMANDO 1995-11-18      M
## 6     108649 KALOPSIDIOTIS                 MARKOS 1991-06-15      M
## 7     125573        MUKTAR       ABDELMALIK TOFIK 1996-04-19      M
## 8     110501        JALLOW                 MIMOSA 1994-06-17      F
## 9     108274        BAQLAH                 TALITA 1995-10-27      F
## 10    102784          HALL                 JOSHUA 1991-04-12      M
## 11    102775       MOROZOV               VLADIMIR 1992-06-16      M
## 13    107019       TYURINA             ANASTASIYA 2001-09-27      F
## 14    113324      ALSHAMSI ALIA ALI ABDULLA MAJED 2000-05-02      F
##                    name code eventid heat lane points reactiontime swimtime
## 1             Australia  AUS     210    2    8     NA         0.71    54.50
## 2                 Benin  BEN      36    2    7     NA         0.88    47.47
## 3  Central African Rep.  CAF      14    3    0     NA         0.77    47.33
## 5                  Cuba  CUB      10    3    2     NA         0.57    55.84
## 6                Cyprus  CYP       6    3    1     NA         0.64    67.96
## 7              Ethiopia  ETH      28    4    0     NA         0.79    27.34
## 8               Finland  FIN      18    4    2     NA         0.42    28.18
## 9                Jordan  JOR      34    7    9     NA         0.74    26.53
## 10          Philippines  PHI      14    6    8     NA         0.66    28.37
## 11               Russia  RUS     219    2    5     NA         0.47    48.12
## 13           Tajikistan  TJK      34    2    6     NA         0.80    32.22
## 14 United Arab Emirates  UAE      11    1    9     NA         0.74   101.02
##    split cumswimtime splitdistance daytime round distance stroke splitswimtime
## 1      1       54.50            50    1748   SEM      100   BACK         54.50
## 2      1       47.47            50    1008   PRE       50 BREAST         47.47
## 3      1       47.33            50     930   PRE       50 BREAST         47.33
## 5      1       55.84            50     949   PRE      100   BACK         55.84
## 6      1       67.96            50    1134   PRE      100 BREAST         67.96
## 7      1       27.34            50     930   PRE       50   FREE         27.34
## 8      1       28.18            50     930   PRE       50   BACK         28.18
## 9      1       26.53            50     930   PRE       50   FREE         26.53
## 10     1       28.37            50     930   PRE       50 BREAST         28.37
## 11     1       48.12            50    1732   SEM      100   FREE         48.12
## 13     1       32.22            50     930   PRE       50   FREE         32.22
## 14     1      101.02            50    1007   PRE      100 BREAST        101.02

Vamos a buscar los resultados de World Aquatics de alguno de ellos, para estimar qué esta sucediendo. ¿Fueron descalificados?.

Nuestro nadador de la primera fila, Ben Treffers, fue descalificado. Buscamos también a Vladimir Morozov, y también fue descalificado. Luego, son participantes que nadaron pero quedaron descalificados. Por tanto, sus datos nos servirán para hacer estudios sobre participación, pero no para cualquier estudio que involucre los resultados. Luego estos, no los eliminamos del dataframe inicial.

datosNA <- datosNA %>%
  filter(!(is.na(datosNA$points)))

Me quedan las dos ultimas observaciones por ver:

datosNA
##   athleteid  lastname          firstname  birthdate gender                 name
## 1    111377 SAUVOUREL CHLOE MARIE HELENE 2000-06-18      F Central African Rep.
## 2    107019   TYURINA         ANASTASIYA 2001-09-27      F           Tajikistan
##   code eventid heat lane points reactiontime swimtime split cumswimtime
## 1  CAF      34    2    8    132           NA    46.55     1       46.55
## 2  TJK      18    1    5    347           NA    38.48     1       38.48
##   splitdistance daytime round distance stroke splitswimtime
## 1            50     930   PRE       50   FREE         46.55
## 2            50     930   PRE       50   BACK         38.48

Tenemos dos observaciones en las cuales no existe el tiempo de reacción. Seguramente se deba a algún fallo en el sistema electrónico o algún fallo al pasar los datos. Por lo tanto, al igual que con los anteriores, no lo eliminaremos de nuestro dataframe inicial, pero sí lo tendremos en cuenta cuando tengamos que analizar estudios que tengan que ver con el tiempo de reacción.

print(sum(is.na(datos2015)))
## [1] 14

Luego, de 309 iniciales, vamos a tratar ahora con 14 datos nulos ya controlados.

Variable birthdate. Creacion de nueva variable edad

A continuación, vamos a crear una variable llamada edad, ya que será más representativo que trabajar con la variable birthdate. La variable tendrá el valor numérico de la edad de cada participante en el momento del mundial. Es decir, el 24 de Julio de 2015.

datos2015$birthdate <- as.Date(datos2015$birthdate)
#Calculamos la edad
fechaKazan<- as.Date("2015-07-24")
datos2015$edad <- as.numeric(difftime(fechaKazan, datos2015$birthdate, units = "weeks")) %/% 52  # Convertir de semanas a años

Además, borramos la variable birthdate:

datos2015$birthdate=NULL

Dataframes.

Si visualizamos el dataframe datos2015, observamos por cada prueba de cada nadador, salen n filas que equivalen a los n parciales (de 50m ) en los que constaba la prueba. Luego, para algunos estudios, usar este dataframe va a suponer duplicar, triplicar e incluso multiplicar por 15 un mismo valor (en el caso de las carreras de 1500m). Además, no estaríamos haciendo un análisis correcto, puesto que los resultados estarían claramente sesgados hacia los de las distancias más largas. Por ejemplo, en el caso del tiempo de reacción, los tiempos de los nadadores de 1500 metros se contabilizarían 15 veces. Mientras que en los nadadores de 50 metros sólo una vez.

A continuación, procedemos a presentar los dataframes que vamos a utilizar dependiendo lo que queramos estudiar:

Dataframe nadadoresParticipantes.

Utilizaremos este dataframe para realizar análisis sobre el número de nadadores, proporción entre hombres y mujeres, la edad de los participantes, etc. Es decir, análisis sobre datos que no requieren el conocimiento de la progresión en sus splits. Para ello, nos bastará con tener la primera fila de cada participante.

Creamos, por tanto, un nuevo dataframe, llamado nadadoresParticipantes, el cual constará de todos los participantes sin repetir. Nos basaremos en la unicidad de la variable athleteid para crearla.

nadadoresParticipantes <- datos2015 %>%
  distinct(athleteid, .keep_all = TRUE)

#guardamos una copia de seguridad por si se modifica el dataframe más adelante. 

nadadoresParticipantesCopia<-nadadoresParticipantes
summary(nadadoresParticipantes)
##    athleteid        lastname          firstname         gender 
##  Min.   :100392   Length:1099        Length:1099        F:491  
##  1st Qu.:101641   Class :character   Class :character   M:608  
##  Median :105575   Mode  :character   Mode  :character          
##  Mean   :107933                                                
##  3rd Qu.:111033                                                
##  Max.   :125573                                                
##                                                                
##             name          code        eventid           heat          lane    
##  China        : 39   CHN    : 39   Min.   : 1.00   2      :182   3      :122  
##  United States: 36   USA    : 36   1st Qu.: 5.00   3      :175   7      :116  
##  Italy        : 31   ITA    : 31   Median :11.00   4      :157   2      :115  
##  Russia       : 30   RUS    : 30   Mean   :13.49   5      :133   5      :114  
##  Australia    : 29   AUS    : 29   3rd Qu.:19.00   1      :130   6      :113  
##  Germany      : 27   GER    : 27   Max.   :40.00   6      :105   8      :111  
##  (Other)      :907   (Other):907                   (Other):217   (Other):408  
##      points       reactiontime       swimtime           split  
##  Min.   : 52.0   Min.   :0.4600   Min.   :  22.01   Min.   :1  
##  1st Qu.:687.5   1st Qu.:0.6600   1st Qu.:  52.77   1st Qu.:1  
##  Median :803.0   Median :0.7000   Median :  63.66   Median :1  
##  Mean   :752.4   Mean   :0.7032   Mean   : 114.92   Mean   :1  
##  3rd Qu.:863.0   3rd Qu.:0.7400   3rd Qu.: 127.39   3rd Qu.:1  
##  Max.   :996.0   Max.   :0.9700   Max.   :1101.09   Max.   :1  
##  NA's   :4       NA's   :2                                     
##   cumswimtime     splitdistance    daytime       round         distance     
##  Min.   : 22.01   Min.   :50    Min.   : 930.0   FIN:   0   Min.   :  50.0  
##  1st Qu.: 26.33   1st Qu.:50    1st Qu.: 930.0   PRE:1099   1st Qu.: 100.0  
##  Median : 28.14   Median :50    Median : 954.0   SEM:   0   Median : 100.0  
##  Mean   : 28.82   Mean   :50    Mean   : 992.7   SOP:   0   Mean   : 184.8  
##  3rd Qu.: 30.16   3rd Qu.:50    3rd Qu.:1030.0   SOS:   0   3rd Qu.: 200.0  
##  Max.   :101.02   Max.   :50    Max.   :1134.0              Max.   :1500.0  
##                                                                             
##     stroke    splitswimtime         edad      
##  BACK  :172   Min.   : 22.01   Min.   :10.00  
##  BREAST:211   1st Qu.: 26.33   1st Qu.:19.00  
##  FLY   :228   Median : 28.14   Median :21.00  
##  FREE  :406   Mean   : 28.82   Mean   :21.32  
##  MEDLEY: 82   3rd Qu.: 30.16   3rd Qu.:24.00  
##               Max.   :101.02   Max.   :38.00  
## 

Dataframe nadadoresPruebas.

Para poder elaborar un estudio de algunas variables como events, reactiontime, lane, heats y daytime,entre otras cosas, vamos a necesitar un dataframe que refleje a cada nadador y sus pruebas nadadas por filas.

Para poder realizar el dataframe, primero hay que saber si cada prueba, dentro de cada tipo de prueba (preliminar, final, semifinal), tiene un id distinto.

Lo evaluamos seleccionando algún nadador que haya nadado en varias rondas:

ejemplo<-datos2015[datos2015$distance == 100 & datos2015$stroke=="BACK" & datos2015$code=="AUS", ]
head(ejemplo,6)
##     athleteid lastname firstname gender      name code eventid heat lane points
## 280    100529   LARKIN  MITCHELL      M Australia  AUS      10    6    5    968
## 281    100529   LARKIN  MITCHELL      M Australia  AUS      10    6    5    968
## 282    100529   LARKIN  MITCHELL      M Australia  AUS     210    2    4    975
## 283    100529   LARKIN  MITCHELL      M Australia  AUS     210    2    4    975
## 284    100529   LARKIN  MITCHELL      M Australia  AUS     110    1    4    973
## 285    100529   LARKIN  MITCHELL      M Australia  AUS     110    1    4    973
##     reactiontime swimtime split cumswimtime splitdistance daytime round
## 280         0.59    52.50     1       25.34            50     949   PRE
## 281         0.59    52.50     2       52.50           100     949   PRE
## 282         0.67    52.38     1       25.28            50    1748   SEM
## 283         0.67    52.38     2       52.38           100    1748   SEM
## 284         0.57    52.40     1       25.41            50    1836   FIN
## 285         0.57    52.40     2       52.40           100    1836   FIN
##     distance stroke splitswimtime edad
## 280      100   BACK         25.34   22
## 281      100   BACK         27.16   22
## 282      100   BACK         25.28   22
## 283      100   BACK         27.10   22
## 284      100   BACK         25.41   22
## 285      100   BACK         26.99   22

Bien, vemos que el australiano nadó tanto las preliminares, como las semifinales como la final y el eventid era distinto entre rondas pero es el mismo en la misma prueba.

Creamos el siguiente dataframe:

nadadoresPruebas <- datos2015 %>%
  distinct(eventid, athleteid, .keep_all = TRUE)

head(nadadoresPruebas,6)
##   athleteid lastname firstname gender    name code eventid heat lane points
## 1    100784   BORSHI      NOEL      F Albania  ALB       1    1    4    680
## 2    100784   BORSHI      NOEL      F Albania  ALB      20    1    8    654
## 3    101712     MECA    KLAVIO      M Albania  ALB       2    1    7    697
## 4    101712     MECA    KLAVIO      M Albania  ALB      12    1    3    640
## 5    110360  MERIZAJ     NIKOL      F Albania  ALB      15    2    9    591
## 6    110360  MERIZAJ     NIKOL      F Albania  ALB      23    2    3    586
##   reactiontime swimtime split cumswimtime splitdistance daytime round distance
## 1         0.77    63.65     1       29.63            50     930   PRE      100
## 2         0.80   140.28     1       31.33            50    1014   PRE      200
## 3         0.74   248.18     1       28.64            50     948   PRE      400
## 4         0.73   118.32     1       27.83            50    1027   PRE      200
## 5         0.84   134.58     1       31.05            50     949   PRE      200
## 6         0.78    62.19     1       29.50            50     930   PRE      100
##   stroke splitswimtime edad
## 1    FLY         29.63   19
## 2    FLY         31.33   19
## 3   FREE         28.64   19
## 4   FREE         27.83   19
## 5   FREE         31.05   17
## 6   FREE         29.50   17
#Copia de seguridad: 
nadadoresPruebasCopia<-nadadoresPruebas

Los datos creados, reflejan nadadores y pruebas nadadas por cada uno.

Estudio sobre el número de nadadores, su género, país y edad.

Usaremos el dataframe nadadoresParticipantes.

Ahora, comenzamos nuestro estudio:

Edad.

Veamos primeramente un resumen de la edad:

summary(nadadoresParticipantes$edad)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   10.00   19.00   21.00   21.32   24.00   38.00

Observamos que la edad máxima fue de 38 años, la media fue de 21.32 años, y el participante con menos edad fue de 10 años. Además, el 50% de los participantes estaban entre 19 y 24 años de edad.

Una pregunta razonable sería: ¿El dato relativo al participante de 10 años es un error?

Procedemos a contrastar la información. De esta forma, podemos ver si de verdad existe este atleta o es un dato mal tomado de nuestra base de datos. Confirmamos la información, entre otras fuentes, con esta noticia, de la cual añadimos el enlace sobre la joven nadadora de 10 años. noticia

Confirmamos mediante su nombre, apellidos y edad, que la noticia se refiere a los datos que tenemos.

datos2015[datos2015$edad == 10, ]
##      athleteid lastname firstname gender    name code eventid heat lane points
## 1349    114036    TAREQ    ALZAIN      F Bahrain  BRN      29    1    2    226
## 1350    114036    TAREQ    ALZAIN      F Bahrain  BRN      34    1    6    291
##      reactiontime swimtime split cumswimtime splitdistance daytime round
## 1349         0.74    41.13     1       41.13            50     954   PRE
## 1350         0.72    35.78     1       35.78            50     930   PRE
##      distance stroke splitswimtime edad
## 1349       50    FLY         41.13   10
## 1350       50   FREE         35.78   10

Se trata de una nadadora de Bahrain que nadó el 50 mariposa y el 50 libres. Luego podemos concluir que es un dato atípico pero no es erróneo.

De acuerdo con esta nueva variable, vemos cómo se distribuyen las edades.

ggplot(nadadoresParticipantes, aes(x = edad)) +
  geom_density(fill = "#0072B2", color = "#0072B2") + # Azul accesible para daltónicos
  ggtitle("Distribución. Edades.")

La mayoría de los nadadores parecen tener entre 15 y 25 años, con un pico alrededor de los 20 años.

Esto sugiere que los participantes en la competición están en su mayoría en la etapa juvenil o temprana adultez.

Podríamos preguntarnos si la edad sigue una distribución normal en estos datos, para ello, hacemos uso del test shapiro:

shapiro.test(nadadoresParticipantes$edad)
## 
##  Shapiro-Wilk normality test
## 
## data:  nadadoresParticipantes$edad
## W = 0.9811, p-value = 9.184e-11

El test de shapiro, a priori, nos indica que deberíamos rechazar la hipótesis nula y suponer que no es una normal, aún así, vamos a evaluar de una manera práctica, si podemos suponer su normalidad. Vamos a realizar 3 evaluaciones para ver si podemos suponer que nuestros datos son normales:

Probabilidad de que un nadador tenga más de 29 años:

Para calcular la probabilidad de que un nadador tenga más de 29 años, cuento todos los nadadores que tienen más de 30, y divido sobre el número total de participantes.

valor1<- sum(nadadoresParticipantes$edad >=29)/1099

Calcular media y varianza y calcular la probabilidad Normal.

media<-mean(nadadoresParticipantes$edad)
desviacion<-sd(nadadoresParticipantes$edad)

valor2<-1 - pnorm(29, media, sd=desviacion)

Simular datos de una normal sabiendo media y varianza.

Ahora, simulo datos:

datos_simulados <- rnorm(1100, mean = media, sd = desviacion)
## Calculo la probabilidad de 29 o más: 

conteo_mayores_que_29 <- sum(datos_simulados >= 29)

valor3<- conteo_mayores_que_29/1100

A continuación, comparo los tres valores obtenidos:

valor1
## [1] 0.04367607
valor2
## [1] 0.02662683
valor3
## [1] 0.01909091

Y veo que es una diferencia de 0.017 entre el mayor y el menor valor, luego, vamos a suponer la normalidad de nuestros datos.

rm(conteo_mayores_que_29, datos_simulados, desviacion, media, valor1, valor2, valor3)

Observo que hay una variación de 0.014 entre las probabilidades, al ser una probabilidad tan baja, podríamos asumir normalidad en nuestros datos.

Análisis de géneros participantes

Veamos el número exacto de mujeres y hombres en la competición:

summary(nadadoresParticipantes$gender)
##   F   M 
## 491 608

Luego, hay 608 hombres y 491 mujeres que participaron en los mundiales de Kazán 2015.

Veamos ahora cómo se distribuyen los hombres y las mujeres y sus respectivas edades:

ggplot(nadadoresParticipantes, aes(x = edad, colour = gender, linetype = gender)) +
    geom_density(size = 1.2) +  # Aumentar el grosor de las líneas
    scale_color_viridis_d(option = "D", begin = 0.2, end = 0.8) +  # Colores accesibles para daltonismo
    scale_linetype_manual(values = c("solid", "dashed")) +  # Líneas sólidas y punteadas
    theme_minimal() +  # Tema limpio y claro
    labs(
        title = "Densidades de Edad por Género",
        x = "Edad",
        y = "Densidad",
        colour = "Género",
        linetype = "Género"
    )

Según observamos, la distribución está ligeramente desplazada a la derecha para los hombres, esto indica que los hombres tienden a ser mayores en promedio que las mujeres. Esta diferencia en la distribución de edades entre los géneros nos conduce a realizar distintos test estadísticos para confirmar si la diferencia realmente es significativa.

Hipótesis:

  • H0: Las medias de los dos grupos son iguales.

  • H1: Las medias de los dos grupos son distintas.

t.test(edad~gender,data=nadadoresParticipantes)
## 
##  Welch Two Sample t-test
## 
## data:  edad by gender
## t = -4.8384, df = 1033.7, p-value = 1.508e-06
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
##  -1.6284460 -0.6886968
## sample estimates:
## mean in group F mean in group M 
##        20.68024        21.83882

Hemos comparado las medias de edad entre mujeres (grupo F) y hombres (grupo M), tomando como hipótesis nula que las medias de edad entre mujeres y hombres son iguales, y cómo hipótesis alternativa que las medias de edad entre mujeres y hombres son diferentes. Aunque el resultado del t-test muestra que hay una diferencia estadísticamente significativa (el p-valor es muy pequeño) entre las edades medias de hombres y mujeres (aproximadamente 1.16 años), en términos prácticos, esta diferencia es relativamente pequeña. En este caso, puede no ser relevante en términos de la experiencia o desempeño de los nadadores.

No obstante, proseguimos en nuestro análisis exploratorio.

tabla1<-table(nadadoresParticipantes$edad>30,nadadoresParticipantes$gender)
chisq.test(tabla1)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tabla1
## X-squared = 0.54325, df = 1, p-value = 0.4611

Por el resultado del siguiente test aplicado, podemos concluir con que no hay asociación significativa: Dado que el p-valor es 0.47, entre ser mayor de 30 años y el género de los nadadores en nuestros datos. En términos sencillos,la edad no parece estar relacionada con el género de los nadadores en cuanto a si son mayores de 30 años.

tabla2<-table(nadadoresParticipantes$edad<20,nadadoresParticipantes$gender)
chisq.test(tabla2)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tabla2
## X-squared = 15.974, df = 1, p-value = 6.423e-05

Hay una diferencia considerable entre las frecuencias observadas (cuántos hombres y mujeres son menores de 20 años) y las frecuencias esperadas bajo la hipótesis nula (que no hay asociación entre edad y género para menores de 20 años). Esto sugiere ir un paso más allá, ¿Hay más mujeres menores de edad que hombres menores de edad?

tabla3<-table(nadadoresParticipantes$edad<18,nadadoresParticipantes$gender)
chisq.test(tabla3)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tabla3
## X-squared = 23.731, df = 1, p-value = 1.108e-06

Los resultados sugieren que el género y la minoría de edad si que están significativamente relacionados en nuestro conjunto de datos de nadadores. Esto podría tener implicaciones para el análisis del rendimiento y la participación en competiciones.

Veamos números,

tabla3
##        
##           F   M
##   FALSE 385 543
##   TRUE  106  65
#Calcular los totales
totales <- colSums(tabla3)

#Calcular el porcentaje de nadadores menores de 18 años por género
porcentajes <- (tabla3[2, ] / totales) * 100  
# fila 2 son los menores de 18

porcentajes
##        F        M 
## 21.58859 10.69079

De esta forma, ya habiendo confirmado una diferencia significativa. Podemos ver, de manera más representativa, como existe el doble de proporción de mujeres menores de edad en comparación con los hombres. Dicho en otras palabras, 2 de cada 10 mujeres son menores de 18 años, mientras que esto sólo ocurre en 1 de cada 10 hombres:

porcentajes <- c(10.88, 21.66)  # 10% para hombres y 20% para mujeres
generos <- c("Hombres", "Mujeres")

porcentajes<- as.data.frame(porcentajes)
#generos<- as.data.frame(generos)

# Crear el gráfico con colores accesibles
ggplot(porcentajes, aes(x = generos, y = porcentajes, fill = generos)) +
  geom_bar(stat = "identity", width = 0.6) +  # Barras con ancho ajustado
  geom_text(aes(label = paste0(porcentajes, "%")), vjust = -0.5, size = 5) +  # Mostrar los porcentajes
  labs(
    title = "Porcentaje de Nadadores Menores de 18 Años por Género",
    x = "Género",
    y = "Porcentaje"
  ) +
  scale_fill_viridis_d(option = "C", begin = 0.2, end = 0.8) +  # Colores accesibles
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16),  # Centrar el título
    axis.title = element_text(size = 14),
    axis.text = element_text(size = 12),
    legend.position = "none"  # Ocultar la leyenda
  ) +
  ylim(0, 100)  # Ajustar el límite del eje Y

Análisis de nacionalidades.

Vamos a ver la cantidad de nadadores por país.

nadadoresParticipantes$iso2 <- countrycode(nadadoresParticipantes$name, "country.name", "iso2c")

nombres<- unique(nadadoresParticipantes$name) #Para no repetir
#print(nombres)
manual <- data.frame(
  nombre = c("Fina", "Kosovo", "Micronesia", "Virgin Islands"),
  iso2 = c("FI", "XK", "FM", "VI")  
)

# Agregamos la variable continente 
nadadoresParticipantes$continent <- countrycode(nadadoresParticipantes$iso2, "iso2c", "continent")



nadadoresParticipantes <- nadadoresParticipantes %>%
  mutate(continent = ifelse(iso2 == "XK", "Europe", continent))  


#nadadores por país
resumen_paises <- nadadoresParticipantes %>%
  group_by(name, iso2, continent) %>%
  summarise(num_nadadores = n(), .groups = "drop") %>%
  arrange(desc(num_nadadores))  # Ordenar por número de nadadores

head(resumen_paises,6)
## # A tibble: 6 × 4
##   name          iso2  continent num_nadadores
##   <fct>         <chr> <chr>             <int>
## 1 China         CN    Asia                 39
## 2 United States US    Americas             36
## 3 Italy         IT    Europe               31
## 4 Russia        RU    Europe               30
## 5 Australia     AU    Oceania              29
## 6 Germany       DE    Europe               27
#Creamos un gráfico con colores
paleta <- c("Americas" = "#0084ff", "Asia" = "#44bec7", 
            "Europe" = "#ffc300", "Oceania" = "#fa3c4c", "Africa"= "#ff6347")

oda_bar <- resumen_paises %>% 
  ggplot(aes(x = reorder(name, num_nadadores), y = num_nadadores, fill = continent)) + 
  geom_flag(y = -10, aes(image = iso2), size = 0.05) +  
  geom_bar(stat = "identity") + 
  labs(title = "Participación de Nadadores por País",
       subtitle = "Datos de nadadores en competiciones",
       x = "País",
       y = "Número de Nadadores") +
  scale_fill_manual(values = paleta) +  # colores personalizados
  expand_limits(y = c(0, max(resumen_paises$num_nadadores) + 10)) +  # Aumentar el límite superior
  coord_flip() +  # Para hacer el gráfico horizontal
  theme_minimal()

# Imprimir el gráfico
print(oda_bar)

Vemos también este mismo gráfico, pero separando los países por continentes.

paleta <- c("Americas" = "#0084ff", 
            "Asia" = "#44bec7", 
            "Europe" = "#ffc300", 
            "Oceania" = "#fa3c4c", "Africa"= "#ff6347")

oda_bar1 <- resumen_paises %>% 
  ggplot(aes(x = reorder(name, num_nadadores), 
             y = num_nadadores, 
             fill = continent)) + 
  geom_flag(y = -10, aes(image = iso2), size = 0.05) +  
  geom_bar(stat = "identity") + 
  labs(title = "Participación de Nadadores por País",
       subtitle = "Datos de nadadores en competiciones",
       x = "País",
       y = "Número de Nadadores") +
  scale_fill_manual(values = paleta) +  # Colores personalizados
  expand_limits(y = c(0, max(resumen_paises$num_nadadores) + 10)) +  # Ajustar el límite superior
  coord_flip() +  # Gráfico horizontal
  theme_minimal() +
  facet_wrap(~ continent, scales = "free_y")  # Separar por continentes

# Imprimir el gráfico
print(oda_bar1)

Como vemos, estos gráficos son poco interpretables debido a la gran cantidad de países. Por ello, intentaremos analizar los resultados en función de proporciones relativas a continentes.

paleta <- c("Americas" = "#0084ff", 
            "Asia" = "#44bec7", 
            "Europe" = "#ffc300", 
            "Oceania" = "#fa3c4c", "Africa"="#ff6347")

# Crear el histograma de cantidad de nadadores por continente
histograma_nadadores <- resumen_paises %>% 
  ggplot(aes(x = continent, y = num_nadadores, fill = continent)) + 
  geom_bar(stat = "identity") +  # Sumar cantidad de nadadores por continente
  labs(title = "Cantidad de Nadadores por Continente",
       x = "Continente",
       y = "Número de Nadadores") +
  scale_fill_manual(values = paleta) +  # Colores personalizados por continente
  theme_minimal()

# Imprimir el histograma
print(histograma_nadadores)

Como podemos observar en los gráficos, la mayor cantidad de nadadores son de procedencia europea, continuando con Asia y Américas, y teniendo baja proporción los nadadores de África y Oceanía.

Nos preguntamos en esta situación, si los Europeos tendrán los puestos más altos en el ranking. Es decir, si existe mayor proporción de ganadores en los países con más densidad de participantes.

Para ello, analizaremos los puntos según las nacionalidades de los nadadores.

puntos_por_pais <- nadadoresPruebas %>%
  group_by(name) %>%  
  summarise(total_puntos = sum(points, na.rm = TRUE))  

# Ver el resultado
head(puntos_por_pais,20)
## # A tibble: 20 × 2
##    name              total_puntos
##    <fct>                    <dbl>
##  1 Albania                   5409
##  2 Algeria                   1450
##  3 Andorra                   3988
##  4 Angola                    4101
##  5 Antigua & Barbuda         4663
##  6 Argentina                15779
##  7 Armenia                   4335
##  8 Aruba                     5880
##  9 Australia               103457
## 10 Austria                  13730
## 11 Azerbaijan                5238
## 12 Bahamas                  10777
## 13 Bahrain                   3324
## 14 Bangladesh                3313
## 15 Barbados                  5287
## 16 Belarus                  17394
## 17 Belgium                  22466
## 18 Benin                     1549
## 19 Bermuda                   2876
## 20 Bolivia                   5144
#Graficar los puntos por país
ggplot(puntos_por_pais, aes(x = reorder(name, total_puntos), y = total_puntos)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  labs(title = "Total de Puntos por País", x = "País", y = "Total de Puntos") +
  coord_flip() +  # Voltear el gráfico para una mejor visualización
  theme_minimal()

De la misma manera que nos ocurría antes, este gráfico es poco interpretativo. Lo vemos por continentes:

# Utilizamos la dataframe nadadoresPruebas
# Agregar el código ISO de dos dígitos. No es posible con la variable CODE, hay que convertir.
nadadoresPruebas$iso2 <- countrycode(nadadoresPruebas$name, "country.name", "iso2c")

nombres<- unique(nadadoresPruebas$name) #Para no repetir

#print(nombres)

#Nombres problemáticos
manual <- data.frame(
  nombre = c("Fina", "Kosovo", "Micronesia", "Virgin Islands"),
  iso2 = c("FI", "XK", "FM", "VI")  
)

# Agregamos la variable continente 
nadadoresPruebas$continent <- countrycode(nadadoresPruebas$iso2, "iso2c", "continent")

#solo es XK(KOSOVO, que está en Europa)
#manualmente el continente para Kosovo (XK)
nadadoresPruebas <- nadadoresPruebas %>%
  mutate(continent = ifelse(iso2 == "XK", "Europe", continent))  


puntos_por_continente <- nadadoresPruebas %>%
  group_by(continent) %>%  #agrupar por continente
  summarise(total_puntos = sum(points, na.rm = TRUE))  #Sumar puntos por continente

print(puntos_por_continente)
## # A tibble: 6 × 2
##   continent total_puntos
##   <chr>            <dbl>
## 1 Africa          151898
## 2 Americas        479297
## 3 Asia            448119
## 4 Europe          964192
## 5 Oceania         160157
## 6 <NA>             15843
#Graficar los puntos por continente
ggplot(puntos_por_continente, aes(x = reorder(continent, total_puntos), y = total_puntos, fill = continent)) +
  geom_bar(stat = "identity") +
  labs(title = "Total de Puntos por Continente", x = "Continente", y = "Total de Puntos") +
  coord_flip() + 
  theme_minimal()

ggplot(na.omit(nadadoresPruebas), aes(x = points, colour = continent)) +
# Añadir la capa de la densidad de probabilidad.
    geom_density()

ggplot(na.omit(nadadoresPruebas), aes(x=continent, y=points, color=continent)) +
  geom_boxplot()

Como podemos observar, parece ser que los Europeos son mejores en el desempeño de las pruebas de natación. Además, presentan una distribución más centrada a la media y sus valores más altos están bastante alejados del resto de los del resto de participantes de otros continentes. Podríamos interpretar que América tiene la segunda distribución más centrada en comparación con el resto de continentes. La esperanza está cercana a Oceanía por debajo pero con menor dispersión. Oceanía también presenta una media bastante alta y cercana a la de Europa. sin embargo, se puede ver como su dispersión es bastante elevada por lo que presenta nadadores de diversa cualificación. La peor esperanza la tiene África, muy por debajo este valor del resto de los continentes. Además presenta una gran dispersión, ya que abarca el rango desde valores cercanos al 0 hasta 1000, sin ser estos visualizados como outliers. Esta información nos podría ser de gran ayuda para dar un posible enfoque a la hora de establecer tendencias en los grupos y a qué se puede deber (clima, tipo de entrenamiento, condiciones sociales en diversos países) la cantidad de puntos en promedio y la variabilidad de estas observaciones.

Anteriormente hemos hallado para cada contiente todos los puntos conseguidos por los nadadores de dicho continente. Lo que vamos a hacer a continuación es normalizar los puntos por continente, es decir, para cada continente tomamos todos los puntos de dicho continente y lo dividimos por todos participantes de ese continente y comparamos.

# Agrupar por continente, sumar puntos y contar participantes
resumenContinente <- nadadoresPruebas %>%
  group_by(continent) %>%
  summarise(
    puntos_totales_continente = sum(points, na.rm = TRUE),
    numero_Participantes_continente = n()  # Contar los participantes
  ) %>%
  mutate(
    relacion_puntos_por_participante = puntos_totales_continente / numero_Participantes_continente
  )

# Imprimir el resultado
print(resumenContinente %>% select(continent, relacion_puntos_por_participante))
## # A tibble: 6 × 2
##   continent relacion_puntos_por_participante
##   <chr>                                <dbl>
## 1 Africa                                589.
## 2 Americas                              808.
## 3 Asia                                  748.
## 4 Europe                                853.
## 5 Oceania                               805.
## 6 <NA>                                  587.

Vemos que Europa tiene el mejor promedio con una cierta diferencia, le siguen América y Oceanía (puntuaciones similares), despúes Asia y por último Africa.

Para terminar con esta sección, vamos a ver los 20 primeros en el ranking, y a hacer un gráfico que nos indique de que pais es cada uno de los 20.

# Filtrar solo las filas de la prueba de 100 metros y ordenar por puntos
datos_100m_top <- nadadoresPruebas[nadadoresPruebas$distance==100,] %>% # Filtra para la prueba de 100 metros
  arrange(desc(points)) %>%           # Ordena por puntos de mayor a menor
  dplyr::slice(1:20)                        # Selecciona las primeras 20 

datos_100m_top
##    athleteid      lastname firstname gender          name code eventid heat
## 1     100728      SJOSTROM     SARAH      F        Sweden  SWE     101    1
## 2     108588         PEATY      ADAM      M Great Britain  GBR     206    2
## 3     100728      SJOSTROM     SARAH      F        Sweden  SWE     201    2
## 4     102630 VAN DER BURGH   CAMERON      M  South Africa  RSA     206    1
## 5     108588         PEATY      ADAM      M Great Britain  GBR       6    9
## 6     108588         PEATY      ADAM      M Great Britain  GBR     106    1
## 7     102630 VAN DER BURGH   CAMERON      M  South Africa  RSA       6    8
## 8     102630 VAN DER BURGH   CAMERON      M  South Africa  RSA     106    1
## 9     100715       SEEBOHM     EMILY      F     Australia  AUS     109    1
## 10    100715       SEEBOHM     EMILY      F     Australia  AUS     209    2
## 11    100529        LARKIN  MITCHELL      M     Australia  AUS     210    2
## 12    100537      CAMPBELL    BRONTE      F     Australia  AUS     123    1
## 13    102231       TITENIS  GIEDRIUS      M     Lithuania  LTU     206    1
## 14    100728      SJOSTROM     SARAH      F        Sweden  SWE       1    7
## 15    100529        LARKIN  MITCHELL      M     Australia  AUS     110    1
## 16    111383       LACOURT   CAMILLE      M        France  FRA     110    1
## 17    100529        LARKIN  MITCHELL      M     Australia  AUS      10    6
## 18    105256        WILSON   MADISON      F     Australia  AUS     109    1
## 19    102277       MURDOCH      ROSS      M Great Britain  GBR     106    1
## 20    102329        HOSSZU   KATINKA      F       Hungary  HUN       9    5
##    lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 1     4   1018         0.67    55.64     1       26.17            50    1740
## 2     4   1014         0.60    58.18     1       27.21            50    1835
## 3     4   1012         0.68    55.74     1       26.46            50    1732
## 4     4    998         0.66    58.49     1       27.36            50    1835
## 5     4    996         0.60    58.52     1       27.05            50    1134
## 6     4    996         0.59    58.52     1       27.20            50    1732
## 7     5    993         0.63    58.59     1       27.11            50    1134
## 8     5    993         0.65    58.59     1       26.79            50    1732
## 9     4    992         0.63    58.26     1       28.46            50    1740
## 10    4    977         0.64    58.56     1       28.51            50    1824
## 11    4    975         0.67    52.38     1       25.28            50    1748
## 12    3    974         0.65    52.52     1       25.15            50    1732
## 13    6    974         0.70    58.96     1       27.71            50    1835
## 14    4    974         0.67    56.47     1       26.54            50     930
## 15    4    973         0.57    52.40     1       25.41            50    1836
## 16    5    969         0.72    52.48     1       25.47            50    1836
## 17    5    968         0.59    52.50     1       25.34            50     949
## 18    3    968         0.58    58.75     1       28.63            50    1740
## 19    8    968         0.64    59.09     1       27.95            50    1732
## 20    5    966         0.64    58.78     1       28.81            50     930
##    round distance stroke splitswimtime edad iso2 continent
## 1    FIN      100    FLY         26.17   22   SE    Europe
## 2    SEM      100 BREAST         27.21   20   GB    Europe
## 3    SEM      100    FLY         26.46   22   SE    Europe
## 4    SEM      100 BREAST         27.36   27   ZA    Africa
## 5    PRE      100 BREAST         27.05   20   GB    Europe
## 6    FIN      100 BREAST         27.20   20   GB    Europe
## 7    PRE      100 BREAST         27.11   27   ZA    Africa
## 8    FIN      100 BREAST         26.79   27   ZA    Africa
## 9    FIN      100   BACK         28.46   23   AU   Oceania
## 10   SEM      100   BACK         28.51   23   AU   Oceania
## 11   SEM      100   BACK         25.28   22   AU   Oceania
## 12   FIN      100   FREE         25.15   21   AU   Oceania
## 13   SEM      100 BREAST         27.71   26   LT    Europe
## 14   PRE      100    FLY         26.54   22   SE    Europe
## 15   FIN      100   BACK         25.41   22   AU   Oceania
## 16   FIN      100   BACK         25.47   30   FR    Europe
## 17   PRE      100   BACK         25.34   22   AU   Oceania
## 18   FIN      100   BACK         28.63   21   AU   Oceania
## 19   FIN      100 BREAST         27.95   21   GB    Europe
## 20   PRE      100   BACK         28.81   26   HU    Europe

Vemos los 20 primeros y de que continente son:

# Contar la cantidad de nadadores por continente
conteo_por_continente <- datos_100m_top %>%
  group_by(continent) %>%                                       # Agrupa por continente
  summarise(cantidad_nadadores = n()) %>%                      # Cuenta los nadadores por continente
  mutate(percent = (cantidad_nadadores / sum(cantidad_nadadores)) * 100)  # Calcula el porcentaje

# Crear el gráfico de distribución porcentual
grafico_distribucion_continente <- ggplot(conteo_por_continente, aes(x = continent, y = percent, fill = continent)) +
  geom_bar(stat = "identity") +
  labs(title = "Distribución Porcentual de Nadadores por Continente en los Top 20 - 100 Metros",
       x = "Continente",
       y = "Porcentaje de Nadadores") +
  scale_fill_manual(values = paleta) +                          # Usa la paleta de colores personalizada
  theme_minimal()

# Imprimir el gráfico
print(grafico_distribucion_continente)

grafico_circular <- ggplot(conteo_por_continente, aes(x = "", y = percent, fill = continent)) +
  geom_bar(stat = "identity", width = 1) +                      # Crea las barras
  coord_polar("y") +                                            # Convierte el gráfico en circular
  labs(title = "Distribución Porcentual de Nadadores por Continente en los Top 20 - 100 Metros",
       fill = "Continente") +                                   # Etiqueta para la leyenda
  scale_fill_manual(values = paleta) +                          # Usa la paleta de colores personalizada
  theme_void()                                                  # Elimina el fondo y ejes

# Imprimir el gráfico
print(grafico_circular)

La alta cantidad de nadadores europeos en el podio de 100 metros(más específico que lo anterior, ya que esto nos mete directamente en los primeros 20) sugiere que hay un fuerte nivel de competencia y entrenamiento en las naciones de este continente. Esto podría estar relacionado con la inversión en programas de natación. Le sigue oceanía,ya que Oceanía, aunque es una región más pequeña en términos de población comparada con Europa, ha producido nadadores destacados que compiten a niveles muy altos. La presencia de nadadores de élite, especialmente de Australia, resalta la calidad del talento en la región.

Los datos indican que África tiene solo un 15% de ganadores en la natación en comparación con otros continentes como Europa y Oceanía, esto puede abrir un amplio espacio para el análisis, ya que muchos países africanos enfrentan desafíos significativos en cuanto a la inversión en infraestructura deportiva. La falta de instalaciones de calidad para la natación, como piscinas adecuadas, puede limitar el desarrollo de talentos.

Realizando un chequeo rápido a la tabla de los 20 mejores, vemos que tenemos South Africa en el top 4 en 100 metros(hemos elegido 100 metros al haber una gran cantidad de nadadores, lo que refleja bien lo que buscamos). Podríamos ver que a pesar de que en África no se llegue mucho al podio, cuando se llega es en los tres primeros puestos. ¿Hemos concluido bien? Veámoslo. Esto es el podio de los 4 primeros en 100 metros

# Filtrar solo las filas de la prueba de 100 metros y ordenar por puntos
datos_100m_top_4 <- nadadoresPruebas[nadadoresPruebas$distance==100,] %>% # Filtra para la prueba de 100 metros
  arrange(desc(points)) %>%           # Ordena por puntos de mayor a menor
  dplyr::slice(1:4)                        # Selecciona las primeras 20 

datos_100m_top_4
##   athleteid      lastname firstname gender          name code eventid heat lane
## 1    100728      SJOSTROM     SARAH      F        Sweden  SWE     101    1    4
## 2    108588         PEATY      ADAM      M Great Britain  GBR     206    2    4
## 3    100728      SJOSTROM     SARAH      F        Sweden  SWE     201    2    4
## 4    102630 VAN DER BURGH   CAMERON      M  South Africa  RSA     206    1    4
##   points reactiontime swimtime split cumswimtime splitdistance daytime round
## 1   1018         0.67    55.64     1       26.17            50    1740   FIN
## 2   1014         0.60    58.18     1       27.21            50    1835   SEM
## 3   1012         0.68    55.74     1       26.46            50    1732   SEM
## 4    998         0.66    58.49     1       27.36            50    1835   SEM
##   distance stroke splitswimtime edad iso2 continent
## 1      100    FLY         26.17   22   SE    Europe
## 2      100 BREAST         27.21   20   GB    Europe
## 3      100    FLY         26.46   22   SE    Europe
## 4      100 BREAST         27.36   27   ZA    Africa

La presencia de Sudáfrica en el cuarto lugar es un indicador de que, a pesar de la baja representación general, el continente tiene al menos algunos atletas de élite que pueden competir con los mejores del mundo.Aunque la cantidad de nadadores africanos en el podio es baja, su éxito en alcanzar los primeros puestos es notable. Esto podría implicar que los nadadores africanos son altamente competitivos cuando tienen la oportunidad de competir en el más alto nivel. Además,al centrarse en la prueba de 100 metros, que tiene una gran cantidad de participantes, se obtiene una visión clara del rendimiento de los nadadores en este evento específico. Esto ayuda a eliminar sesgos que podrían surgir al mirar pruebas con menos competidores.

# Crear un gráfico para visualizar el podio de los 3 primeros
grafico_podio_100m <- ggplot(datos_100m_top_4, aes(x = reorder(lastname, points), y = points, fill = continent)) +
  geom_bar(stat = "identity") +
  labs(title = "Podio de los 4 Primeros en 100 Metros",
       x = "Nadador",
       y = "Puntos",
       fill = "Continente") +
  scale_fill_manual(values = paleta) +  # Usa la paleta de colores que ya definiste
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Mejorar legibilidad

# Imprimir el gráfico
print(grafico_podio_100m)

grafico_podio_100mrepresentacion <- ggplot(datos_100m_top_4, aes(x = reorder(continent, points), y = points, fill = continent)) +
  geom_bar(stat = "identity") +
  labs(title = "Representación podium de África VS Europa  (en Puntos)",
       x = "Nadador",
       y = "Puntos",
       fill = "Continente") +
  scale_fill_manual(values = paleta) +  # Usa la paleta de colores que ya definiste
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Mejorar legibilidad

# Imprimir el gráfico
print(grafico_podio_100mrepresentacion)

Estudio sobre los eventos, reactiontime, lane, heats, daytime:

Reactiontime. Hombres vs Mujeres.

Veamos cómo se distribuyen los datos de tiempo de reacción de todos los nadadores. Para ello, no tenemos en cuenta las dos filas con datos nulos.

ggplot(na.omit(nadadoresPruebas), aes(x = reactiontime)) +
  geom_density(color = viridis(1, option = "C"), fill = viridis(1, option = "C", alpha = 0.5), size = 1.2) +
  ggtitle("Distribución de Reaction Time") +
  labs(x = "Tiempo de Reacción", y = "Densidad") +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),  # Centrar y resaltar el título
    axis.title = element_text(size = 14),  # Aumentar tamaño de etiquetas de los ejes
    axis.text = element_text(size = 12)  # Aumentar el tamaño de los valores de los ejes
  )

Parece que los datos siguen una distribución normal a priori. Igual que antes, vamos a hacer el test de shapiro:

shapiro.test(na.omit(nadadoresPruebas$reactiontime))
## 
##  Shapiro-Wilk normality test
## 
## data:  na.omit(nadadoresPruebas$reactiontime)
## W = 0.99291, p-value = 1.774e-10

Al tener un p-valor tan bajo, no parece que siga una distribución normal.

(HACER AQUÍ LO MISMO QUE CON LA EDAD).

Comparamos las funciones de densidad de mujeres y hombres en general:

nadadoresPruebas <- nadadoresPruebas %>% filter(!is.na(nadadoresPruebas$reactiontime))
ggplot(nadadoresPruebas, aes(x = reactiontime, colour = gender, linetype = gender)) +
  geom_density(size = 1.2) +
  scale_color_viridis_d(option = "C", begin = 0.3, end = 0.7) +  # Colores accesibles
  scale_linetype_manual(values = c("solid", "dashed")) +  # Líneas sólidas y punteadas
  labs(
    title = "Distribución del Tiempo de Reacción por Género",
    x = "Tiempo de Reacción",
    y = "Densidad",
    colour = "Género",
    linetype = "Género"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),  # Centrar el título
    axis.title = element_text(size = 14),  # Tamaño de las etiquetas de los ejes
    axis.text = element_text(size = 12),  # Tamaño de los valores de los ejes
    legend.position = "top",  # Ubicar la leyenda en la parte superior
    legend.title = element_text(size = 12),
    legend.text = element_text(size = 11)
  )

De esta gráfica nos podemos plantear realizar un contraste de hipótesis, en el cual analizaremos sobre la posible diferencia significativa del tiempo de reacción en ambos géneros. Por tanto, realizamos el siguiente test:

  • H0: El tiempo de reacción es igual en mujeres y hombres.
  • H1: El tiempo de reacción es menor en hombres que en mujeres.
t.test(reactiontime~gender,data=nadadoresParticipantes)
## 
##  Welch Two Sample t-test
## 
## data:  reactiontime by gender
## t = 6.3102, df = 1018, p-value = 4.15e-10
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
##  0.01681298 0.03198889
## sample estimates:
## mean in group F mean in group M 
##       0.7166871       0.6922862

Si observamos los resultados, el p- valor nos indica que hay una evidencia significativa para rechazar la hipótesis nula, y por ende concluir con que hay una diferencia estadística en el tiempo de reacción dependiendo del género. Ahora que hemos determinado que la diferencia es estadísticamente significativa, es importante considerar si la diferencia es también significativa en la práctica o si tiene relevancia a la hora de los resultados finales. Calculamos la diferencia relativa, ya que los tiempos de reacción son muy pequeños y de esta forma nos podemos hacer una idea de lo representativa que es la diferencia de medias.

mediaTiempoReaccion <- mean(nadadoresPruebas$reactiontime)
mediaTiempoReaccion
## [1] 0.6964551
(0.7166871-0.6922862)/mediaTiempoReaccion*100
## [1] 3.503586

Obtenemos que las mujeres tardan un 3.5% más de tiempo que los hombres. Es decir que, si mantenemos en igualdad todas las demás variables, si un hombre tarda 22 segundos en un 50, una mujer tardará 3.5% más de tiempo, es decir, 22.77 segundos. Una diferencia significativamente grande si hablamos de una prueba tan corta.

Reactiontime. Distancias largas vs distancias cortas.

Vamos a comparar ahora las funciones de densidad de las chicas en la prueba de 800m libres y 50m libres:

Primeramente calculamos el conjunto de datos:

nadadorasComparacionReactionTime<-nadadoresPruebas[(nadadoresPruebas$distance==50 | nadadoresPruebas$distance==800) & nadadoresPruebas$gender=="F" , ]
ggplot(nadadorasComparacionReactionTime, aes(x = factor(distance), y = reactiontime, fill = factor(distance))) +
  geom_boxplot(alpha = 0.7, size = 1.2, outlier.shape = 16, outlier.size = 4) +  # Mejorar visibilidad de los outliers
  scale_fill_viridis_d(option = "D", begin = 0.2, end = 0.8) +  # Usar colores accesibles de viridis
  labs(
    title = "Boxplot de Tiempo de Reacción: 50m vs 800m",
    x = "Distancia (m)",
    y = "Tiempo de Reacción"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),  # Centrar y resaltar el título
    axis.title = element_text(size = 14),  # Etiquetas de los ejes más grandes
    axis.text = element_text(size = 12),  # Etiquetas del eje
    legend.position = "none"  # Ocultar leyenda ya que está implícita en las etiquetas
  )

El gráfico muestra los boxplots del tiempo de reacción para la prueba de 50 metros y otra para 800 metros.

ggplot(nadadorasComparacionReactionTime, aes(x = reactiontime, fill = factor(distance), group = distance)) +
  geom_density(alpha = 0.6, size = 1.2) +  # Curvas semi-transparentes con líneas más gruesas
  scale_fill_viridis_d(option = "D", begin = 0.2, end = 0.8) +  # Colores accesibles con viridis
  ggtitle("Distribución del Tiempo de Reacción: 800m vs 50m Libre") +
  labs(fill = "Distancia (m)") +  
  theme_minimal() +  
  xlab("Tiempo de Reacción (s)") +  
  ylab("Densidad") +
  theme(
    plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),  # Centrar y resaltar el título
    axis.title = element_text(size = 14),  # Etiquetas de los ejes más grandes
    axis.text = element_text(size = 12),  # Etiquetas del eje
    legend.position = "top"  # Colocar la leyenda en la parte superior
  )

Las curvas se encuentran en un rango de aproximadamente 0.5 a 1 segundos, que representa los tiempos de reacción. Para los 50 metros, la densidad es más alta en el rango de tiempos de reacción más cortos, lo que indica que las nadadoras tienden a tener tiempos de reacción más rápidos en esta distancia. Esto es esperado, ya que la carrera de 50 metros es más corta y requiere reacciones más rápidas y explosivas. En cuanto a la de 800 metros, la curva muestra una mayor dispersión en los tiempos de reacción, con una densidad más amplia. Esto sugiere que los tiempos de reacción son más variados en esta distancia, probablemente debido a la naturaleza más larga y estratégica de la carrera, donde el triunfo de las nadadoras puede estar influenciado por otras variables más determinantes.

Aquí también podemos hacer un test de hipótesis.

t.test(reactiontime~distance,data=nadadorasComparacionReactionTime)
## 
##  Welch Two Sample t-test
## 
## data:  reactiontime by distance
## t = -9.0879, df = 70.242, p-value = 1.771e-13
## alternative hypothesis: true difference in means between group 50 and group 800 is not equal to 0
## 95 percent confidence interval:
##  -0.09391651 -0.06011486
## sample estimates:
##  mean in group 50 mean in group 800 
##         0.6922000         0.7692157

Veamos nuestros resultados del test. Por un lado tenemos el valor del estadístico t calculado, como es un valor negativo indica que la media del primer grupo (50 metros) es menor que la del segundo grupo (800 metros).El valor del p-valor (que es extremadamente bajo) indica que hay una diferencia estadísticamente significativa entre las medias de los dos grupos. Las nadadoras que participan en distancias más cortas (50 metros) tienen un tiempo de reacción más rápido en comparación con aquellas que nadan distancias más largas (800 metros).Luego, habíamos identificado correctamente la tendencia del gráfico, en términos estadísticos.

A continuación, realizamos el mismo estudio pero con hombres y vemos si la situación es similar.

nadadoresComparacionReactionTime<-nadadoresPruebas[(nadadoresPruebas$distance==50 | nadadoresPruebas$distance==800) & nadadoresPruebas$gender=="M", ]
ggplot(nadadoresComparacionReactionTime, aes(x = factor(distance), y = reactiontime, fill = factor(distance))) +
  geom_boxplot() +
  labs(title = "Boxplot de Reaction Time: 50m vs 800m en hombres",
       x = "Distancia (m)",
       y = "Tiempo de Reacción") +
  scale_fill_manual(values = c("50" = "#0084ff", "800" = "#fa3c4c")) +  
  theme_minimal()

# Crear el gráfico de densidad con colores por distancia
ggplot(nadadoresComparacionReactionTime, aes(x = reactiontime, fill = factor(distance), group = distance)) +
  geom_density(alpha = 0.6) +  #curvas 
  scale_fill_manual(values = c("50" = "#0084ff", "800" = "#fa3c4c")) +  
  ggtitle("Distribución del Tiempo de Reacción: 800m libre vs 50m en hombres") +
  labs(fill = "Distancia (m)") +  
  theme_minimal() +  
  xlab("Tiempo de Reacción (s)") +  
  ylab("Densidad")

t.test(reactiontime~distance,data=nadadoresComparacionReactionTime)
## 
##  Welch Two Sample t-test
## 
## data:  reactiontime by distance
## t = -9.6378, df = 87.851, p-value = 2.027e-15
## alternative hypothesis: true difference in means between group 50 and group 800 is not equal to 0
## 95 percent confidence interval:
##  -0.07116093 -0.04683087
## sample estimates:
##  mean in group 50 mean in group 800 
##         0.6742694         0.7332653

Al realizar el t-test para este grupo, vemos también como la diferencia es significativa entre el tiempo de reacción para la prueba de 50 metros y la de 800.

La diferencia entre estos dos extremos en las pruebas es muy significativa. Dados estos resultados, queremos ver las tendencias en las carreras de distancia intermedia, dada nuestra intuición de que el tiempo de reacción aumente de manera gradual. Es decir, cuál es la diferencia entre las pruebas de 50 metros, las de 100, 200, etc.

Para ello, realizaremos un gráfico de densidad conjunto.

ggplot(nadadoresPruebas, aes(x = reactiontime, color = as.factor(distance), fill = as.factor(distance))) +
  geom_density(alpha = 0.5) +  # Ajustar la transparencia
  ggtitle("Distribución comparada de Reaction time") +
  labs(x = "Tiempo de Reacción", y = "Densidad", color = "Distancia", fill = "Distancia") +
  theme_minimal()

Como podemos observar, nuestras suposiciones parecen ser ciertas acerca de que las medias de los tiempos de reacción aumentan según la carrera es más larga. Si bien es cierto, para distancias largas, como son 800 y 1500 metros, no se observan diferencias en torno a su valor central. Del mismo modo, para carreras de 100 y 200 tampoco se observa una diferencia signifiticativa.

Contrastamos esto de forma más precisa realizando el test ANOVA de diferencia de medias.

anova_tiempoReaccion_distancia <- aov(reactiontime ~ as.factor(distance), data = na.omit(nadadoresPruebas))
summary(anova_tiempoReaccion_distancia)
##                       Df Sum Sq Mean Sq F value Pr(>F)    
## as.factor(distance)    5  1.025  0.2049   56.98 <2e-16 ***
## Residuals           2786 10.021  0.0036                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Interpretando estos resultados, tenemos que el p-valor es de orden e^-16. Por ello, podemos concluir que hay diferencias significativas en los tiempos de reacción entre al menos uno de los grupos de distancia. Esto indica que, al menos una distancia tiene un tiempo de reacción diferente en comparación con las otras distancias. El valor de F es alto (56.98), sugiere que la variación entre los grupos es mucho mayor que la variación dentro de los grupos. Esto refuerza la idea de que las medias de los tiempos de reacción son significativamente diferentes entre las carreras de diferente distancia.

Calles usadas.

Veamos cómo se distribuyen las calles usadas:

ggplot(nadadoresPruebas, aes(x = nadadoresPruebas$lane, fill = factor(lane))) + 
  geom_bar() +
  scale_fill_viridis_d(option = "D") + # Paleta Okabe-Ito
  theme_bw() +
  labs(fill = "Lane") # Etiqueta para la leyenda

Se observa que las calles menos usadas son tanto la 0 como la 9. Esto es un dato que puede resultar curioso al visualizar los datos, pero tiene una clara explicación.

Las calles 0 y 9 sólo son usadas en las rondas preliminares. Además, las series de cada prueba se confeccionan rellenando de mejor a peor tiempo con el siguiente orden: 4-5-3-6-2-7-1-8-0-9. Luego, es obvio que si en una prueba tengo 18 nadadores, una serie ocupará todas las calles, pero otra ocupará sólo 8, luego las calles 0 y 9 quedarán libres.

¿Habrá alguna relación entre la calle usada y el tiempo de reacción?

ggplot(nadadoresPruebas, aes(x = reactiontime, color = factor(lane), fill = factor(lane))) +
  geom_density(alpha = 0.6) + # Densidades con transparencia
  facet_wrap(~ lane) +        # Facetas por lane
  theme_bw() +
  labs(
    title = "Distribución de Densidades de Tiempos de Reacción por Calle",
    x = "Tiempo de Reacción",
    y = "Densidad",
    color = "Lane", 
    fill = "Lane"
  ) +
  scale_fill_viridis_d(option = "D") +  # Paleta daltónica para relleno
  scale_color_viridis_d(option = "D")  # Paleta daltónica para bordes

Como podemos ver, no parece haber diferencias significativas según el tipo de calle en los tiempos de reacción.

De nuevo, podemos realizar un test anova sobre la diferencia de medias.

anova_tiempoReaccion_Calles <- aov(reactiontime ~ as.factor(lane), data = na.omit(nadadoresPruebas))
summary(anova_tiempoReaccion_Calles)
##                   Df Sum Sq  Mean Sq F value  Pr(>F)   
## as.factor(lane)    9  0.094 0.010456   2.656 0.00457 **
## Residuals       2782 10.951 0.003937                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

El p-valor de nuestro análisis es menor de 0.005, por lo que podríamos sugerir que sí tiene cierta influencia según el número de calle empleada. Sin embargo, existen muchas variables en nuestro conjunto de datos que podrían influir, por lo que no tiene sentido seguir con este estudio.

Daytime.

Si observamos los valores que toma la variable Daytime, observamos que toma valores numéricos de 3 y 4 cifras. Parece corresponder a la hora y minutos en la que cada nadador nadó la prueba. Luego vamos a cambiar su formato para intentar sacar conclusiones acerca de esta variable:

# Función para convertir
convertir_a_hhmm <- function(tiempo_numerico) {
  # Convertir el número a un string y separar horas y minutos
  horas <- tiempo_numerico %/% 100
  minutos <- tiempo_numerico %% 100
  
  # Crear un objeto de tiempo en formato hh:mm
  tiempo_formateado <- sprintf("%02d:%02d", horas, minutos)
  return(tiempo_formateado)
}

# Aplicar la función a todos los tiempos
tiempos_hhmm <- sapply(nadadoresPruebas$daytime, convertir_a_hhmm)
head(tiempos_hhmm)
## [1] "09:30" "10:14" "09:48" "10:27" "09:49" "09:30"

Bien, ya hemos convertido esos números de 3 y 4 cifras a un formato hora/minutos. Ahora, lo representamos en una gráfica:

# Crear la columna 'tiempo_hhmm'
nadadoresPruebas$tiempo_hhmm <- sapply(nadadoresPruebas$daytime, convertir_a_hhmm)

# Convertir la nueva columna 'tiempo_hhmm' a formato POSIXct
nadadoresPruebas$tiempo_hhmm <- as.POSIXct(nadadoresPruebas$tiempo_hhmm, format = "%H:%M")

# Creo la gráfica.
ggplot(nadadoresPruebas, aes(x = tiempo_hhmm)) +
  geom_histogram(
    binwidth = 3600, 
    color = "black", 
    fill = viridis(1, option = "D")  # Paleta daltónica
  ) +
  scale_x_datetime(date_labels = "%H:%M", breaks = "1 hour") +  # Etiquetas cada hora
  labs(
    x = "Tiempo (hh:mm)",
    y = "Frecuencia de nadadores"
  ) +
  theme_minimal()

Luego, podemos observar de manera clara que, cada día de competición constaba de 2 sesiones, una matinal y otra vespertina, y que las franjas horarias van, por la mañana de 9:30 a 12:30, y por la tarde de 17:30 a 19:30.

Pruebas matinales y vespertinas.

Observamos que el número de nadadores que nadan por la mañana es mucho mayor al de por la tarde.

Vamos a ver un resumen de qué pruebas se nadan por la mañana y cuáles por la tarde:

nadadoresPruebas$tiempo_hhmm<- as.POSIXct(nadadoresPruebas$tiempo_hhmm, format = "%H:%M")
#intervalo para las matinales
limite_inferior1 <- as.POSIXct("09:30", format = "%H:%M")
limite_superior1 <- as.POSIXct("13:00", format = "%H:%M")
#intervalo para las vespertinas
limite_inferior <- as.POSIXct("17:00", format = "%H:%M")
limite_superior <- as.POSIXct("20:00", format = "%H:%M")
#Creamos los dataframes.
pruebasMatinales<-subset(nadadoresPruebas, nadadoresPruebas$tiempo_hhmm >= limite_inferior1 & nadadoresPruebas$tiempo_hhmm <= limite_superior1)

pruebasVespertinas<-subset(nadadoresPruebas, nadadoresPruebas$tiempo_hhmm >= limite_inferior & nadadoresPruebas$tiempo_hhmm <= limite_superior)

Bien, dividida ya nuestras pruebas en la sesion matinal y la vespertina, veamos un resumen de los datos:

dim(pruebasMatinales)
## [1] 2113   22
dim(pruebasVespertinas)
## [1] 693  22

De aquí observamos que, mientras que por las mañanas se nada un 75% de las pruebas del mundial, por las tardes sólo se nada un 25%. Veamos si hay alguna variable que nos pueda ayudar:

print("Resumen de rondas nadadas en sesiones matinales.")
## [1] "Resumen de rondas nadadas en sesiones matinales."
summary(pruebasMatinales$round)
##  FIN  PRE  SEM  SOP  SOS 
##    0 2111    0    2    0
print("Resumen de rondas nadadas en sesiones vespertinas.")
## [1] "Resumen de rondas nadadas en sesiones vespertinas."
summary(pruebasVespertinas$round)
## FIN PRE SEM SOP SOS 
## 271   0 416   0   6

Luego podemos concluir que, el formato que sigue el mundial de Kazán 2015 es, nadar por las mañanas las series preliminares de cada prueba, mientras que por las tardes sólo nadan los nadadores clasificados a semifinales y finales.

## Warning in rm(limite_inferior, limite_inferior1, limite_superior,
## limite_superior1, : objeto 'colores' no encontrado

Estudio sobre la variable distancia y su asociación con los tipos de nado.

A continuación, nos preguntamos, ¿existen pruebas por cada estilo y cada distancia? Es decir, al haber 5 estilos y 6 distancias, ¿hay 30 pruebas distintas? Vamos a responder a la pregunta analizando el dataframe nadadoresPruebas:

Para analizar la relación entre las distancias y los estilos de nado en este conjunto de datos, examinaremos cómo se distribuyen los distintos estilos (BACK, BREAST, FLY, FREE, MEDLEY) en función de la distancia recorrida en metros (50, 100, 200, 400, 800, 1500).

distancia_stroke <- table(nadadoresPruebas$distance, nadadoresPruebas$stroke)
print(distancia_stroke)
##       
##        BACK BREAST FLY FREE MEDLEY
##   50    169    200 192  279      0
##   100   182    195 192  253      0
##   200   129    152 127  190    136
##   400     0      0   0  133     92
##   800     0      0   0  100      0
##   1500    0      0   0   85      0

A partir de la tabla proporcionada, se observa lo siguiente:

  • Las pruebas nadadas en 50m y 100m son los 4 estilos. (BACK, BREAST, FLY, FREE). No se nada MEDLEY ya que, al ser un mundial en piscina de 50m, no podemos cumplir que se nade como mínimo un largo a cada estilo, ya que en estas pruebas sólo se nada 1 o 2 largos en total.

  • En las pruebas contempladas para 200m, entran los 5 estilos. (BACK, BREAST, FLY, FREE).

  • En la distancia de 400m, sólo hay 2 pruebas. 400m Medley y 400m Free.

  • En 800 y 1500m, sólo hay 1 prueba respectivamente, cuyo estilo (stroke) es libre (FREE)

Estas conclusiones se ven muy claras en el siguiente gráfico:

ggplot(nadadoresPruebas, aes(x = factor(distance), y = stroke)) +
  geom_count(aes(color = ..n.., size = ..n..)) +  # Color y tamaño según la frecuencia
  scale_color_viridis_c(option = "D") +          # Paleta continua para daltónicos
  labs(
    x = "Distancia",
    y = "Estilo de Nado",
    size = "Frecuencia",
    color = "Frecuencia"
  ) +
  ggtitle("Frecuencia de Estilos de Nado según la Distancia") +
  theme_minimal()
## Warning: The dot-dot notation (`..n..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(n)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Además, podemos observar que contra más larga es la prueba, menos frecuencia tiene, es decir, menos nadadores participan. Esto tiene sentido ya que, si participasen los mismos nadadores en una prueba de 50 metros que en una de 1500, entonces las sesiones durarían todo el día o incluso habría que extender los días que comprenden el mundial.

Ahora nos preguntamos, ¿hay las mismas pruebas para mujeres y hombres?

Primero, crearemos subconjuntos de datos para cada género.

# Filtrar los datos por género
nadadoresFemeninas <- subset(nadadoresPruebas, gender == "F")
nadadoresMasculinos <- subset(nadadoresPruebas, gender == "M")
#género femenino
nadadorasPruebas<- nadadoresPruebas[nadadoresPruebas$gender=="F", ]

ggplot(nadadorasPruebas, aes(x = factor(distance), y = stroke)) +
  geom_count(aes(color = ..n.., size = ..n..)) +  # Color y tamaño según la frecuencia
  scale_color_viridis_c(option = "D") +          # Paleta continua para daltónicos
  labs(
    x = "Distancia",
    y = "Estilo de Nado",
    size = "Frecuencia",
    color = "Frecuencia"
  ) +
  ggtitle("Frecuencia de Estilos de Nado según la Distancia para Mujeres") +
  theme_minimal()

nadadoresPruebasM<- nadadoresPruebas[nadadoresPruebas$gender=="M", ]

ggplot(nadadoresPruebasM, aes(x = factor(distance), y = stroke)) +
  geom_count(aes(color = ..n.., size = ..n..)) +  # Color y tamaño según la frecuencia
  scale_color_viridis_c(option = "D") +          # Paleta continua para daltónicos
  labs(
    x = "Distancia",
    y = "Estilo de Nado",
    size = "Frecuencia",
    color = "Frecuencia"
  ) +
  ggtitle("Frecuencia de Estilos de Nado según la Distancia para Hombres") +
  theme_minimal()

Parece que todo está funcionando como esperábamos, tanto en el análisis conjunto como en los análisis individuales. Esto confirma que los resultados son consistentes y los datos están bien estructurados para las pruebas.

## Warning in rm(distancia_stroke, tabla_femenino, tabla_masculino,
## nadadoresFemeninas, : objeto 'tabla_femenino' no encontrado
## Warning in rm(distancia_stroke, tabla_femenino, tabla_masculino,
## nadadoresFemeninas, : objeto 'tabla_masculino' no encontrado

Estudio sobre la relación entre la edad de los nadadores y las distancias que nadan..

#Crear una nueva columna para clasificar por edad
nadadoresPruebas <- nadadoresPruebas %>%
  mutate(grupo_edad = ifelse(edad < 18, "Menores de 18", "18 y más"))

#Resumir el número de participantes en cada prueba por grupo de edad
resumen_pruebas <- nadadoresPruebas %>%
  group_by(grupo_edad , distance) %>%  # Agrupar por grupo de edad y prueba(LO MIRO POR DISTANCIAS)
  summarise(num_participantes = n(),.groups = "drop") %>%  #Contar el número de participantes
  ungroup() %>%  # Quitar agrupación
  arrange(grupo_edad, desc(num_participantes))  #Ordenar los resultados

# Mostrar el resumen
resumen_pruebas
## # A tibble: 12 × 3
##    grupo_edad    distance num_participantes
##    <chr>            <int>             <int>
##  1 18 y más            50               725
##  2 18 y más           100               720
##  3 18 y más           200               667
##  4 18 y más           400               199
##  5 18 y más           800                87
##  6 18 y más          1500                75
##  7 Menores de 18       50               115
##  8 Menores de 18      100               102
##  9 Menores de 18      200                67
## 10 Menores de 18      400                26
## 11 Menores de 18      800                13
## 12 Menores de 18     1500                10

Para poder analizar correctamente la tendencia de los nadadores según su grupo de edad, no podemos quedarnos en las frecuencias absolutas.

Debemos analizar los resultados según sus frecuencias relativas.

# Crear una nueva columna para clasificar por edad
nadadoresPruebas <- nadadoresPruebas %>%
  mutate(grupo_edad = ifelse(edad < 18, "Menores de 18", "18 y más"))

# Contar el número total de nadadores
total_nadadores <- nrow(nadadoresPruebas)

# Resumir el número de participantes en cada prueba por grupo de edad
resumen_pruebas <- nadadoresPruebas %>%
  group_by(grupo_edad, distance) %>%  # Agrupar por grupo de edad y prueba
  summarise(num_participantes = n(), .groups = "drop") %>%  # Contar el número de participantes
  mutate(porcentaje = (num_participantes / total_nadadores) * 100) %>%  # Calcular el porcentaje
  ungroup() %>%  # Quitar agrupación
  arrange(grupo_edad, desc(num_participantes))  # Ordenar los resultados

# Mostrar el resumen
print(resumen_pruebas)
## # A tibble: 12 × 4
##    grupo_edad    distance num_participantes porcentaje
##    <chr>            <int>             <int>      <dbl>
##  1 18 y más            50               725     25.8  
##  2 18 y más           100               720     25.7  
##  3 18 y más           200               667     23.8  
##  4 18 y más           400               199      7.09 
##  5 18 y más           800                87      3.10 
##  6 18 y más          1500                75      2.67 
##  7 Menores de 18       50               115      4.10 
##  8 Menores de 18      100               102      3.64 
##  9 Menores de 18      200                67      2.39 
## 10 Menores de 18      400                26      0.927
## 11 Menores de 18      800                13      0.463
## 12 Menores de 18     1500                10      0.356

Lo veo gráficamente:

# Gráfico de barras para el número de participantes por grupo de edad y distancia
ggplot(resumen_pruebas, aes(x = factor(distance), y = num_participantes, fill = grupo_edad)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Número de Participantes por Distancia y Grupo de Edad",
       x = "Distancia (m)",
       y = "Número de Participantes",
       fill = "Grupo de Edad") +
  theme_minimal()

La distancia de 100 y 50 metros es la distancia más popular entre los nadadores mayores de 18 años. Le sigue la distancia de 200 metros. La participación disminuye considerablemente en distancias más largas, como 1500 metros. Para los menores de 18 años tenemos carreras de 100 y 50 metros como las más frecuentadas, aunque menos que el grupo de 18 años o más(hay menos menores). La participación en distancias más largas, como 400 metros, es aún más baja en menores.

Los nadadores mayores de 18 años tienen una participación significativamente mayor en todas las distancias en comparación con los menores de 18 años. La participación en distancias más largas tiende a ser baja en ambos grupos, pero la caída es más pronunciada en los menores de 18.

Tratando de analizar los datos obtenidos podemos concluir con que la distancia de 50 metros es la más popular entre los nadadores. Sin embargo, la diferencia en el número de participantes entre ambos grupos de edad es significativa. Este es un dato que es evidente con nuestras observaciones anteriores, ya que vimos que la media de los participantes está en torno a 21 años. Por tanto, hay más de la mitad de los participantes en el segundo grupo. Lo que si podemos apreciar es que se observa una tendencia de disminución en la participación a medida que las distancias aumentan.

# Gráfico de líneas para mostrar la tendencia
resumen_pruebas
## # A tibble: 12 × 4
##    grupo_edad    distance num_participantes porcentaje
##    <chr>            <int>             <int>      <dbl>
##  1 18 y más            50               725     25.8  
##  2 18 y más           100               720     25.7  
##  3 18 y más           200               667     23.8  
##  4 18 y más           400               199      7.09 
##  5 18 y más           800                87      3.10 
##  6 18 y más          1500                75      2.67 
##  7 Menores de 18       50               115      4.10 
##  8 Menores de 18      100               102      3.64 
##  9 Menores de 18      200                67      2.39 
## 10 Menores de 18      400                26      0.927
## 11 Menores de 18      800                13      0.463
## 12 Menores de 18     1500                10      0.356
ggplot(resumen_pruebas, aes(x = distance, y = num_participantes, color = grupo_edad, group = grupo_edad)) +
  geom_line(size = 1) +
  geom_point(size = 3) +
  labs(title = "Tendencia de Participación en Distancias de Natación por Grupo de Edad",
       x = "Distancia (m)",
       y = "Número de Participantes") +
  scale_x_continuous(breaks = unique(resumen_pruebas$distance)) +
  scale_color_manual(values = c("blue", "orange")) +
  theme_minimal()

La distancia de 50 metros es la más popular, tanto para mayores como para menores de 18 años. La participación de los mayores de 18 años es considerablemente más alta en todas las distancias. La caída en la participación es más pronunciada en el grupo de menores de 18 años, especialmente en distancias más largas.

Nos vamos a centrar, en una de las conclusiones que hemos mencionado varias veces. En los menores de edad,¿realmanete hay una diferencia significativa entre el número de nadadores en las pruebas más explosivas, que en las pruebas más largas? Para ello, creamos una nueva columna, que nos indique que prueba es explosiva, y cual de más resistencia. A continuación, procedo a quedarme con lo que me interesa(menores de edad agrupados en explosivo y resistencia)

resumen_pruebas
## # A tibble: 12 × 4
##    grupo_edad    distance num_participantes porcentaje
##    <chr>            <int>             <int>      <dbl>
##  1 18 y más            50               725     25.8  
##  2 18 y más           100               720     25.7  
##  3 18 y más           200               667     23.8  
##  4 18 y más           400               199      7.09 
##  5 18 y más           800                87      3.10 
##  6 18 y más          1500                75      2.67 
##  7 Menores de 18       50               115      4.10 
##  8 Menores de 18      100               102      3.64 
##  9 Menores de 18      200                67      2.39 
## 10 Menores de 18      400                26      0.927
## 11 Menores de 18      800                13      0.463
## 12 Menores de 18     1500                10      0.356
# Clasificar las distancias
resumen_pruebas <- resumen_pruebas %>%
  mutate(tipo_prueba = case_when(
    distance %in% c(50, 100) ~ "Explosiva",
    distance %in% c(200, 400, 800, 1500) ~ "Resistencia",
    TRUE ~ "Otra"
  ))

# Filtrar solo los menores de 18 años y contar las participaciones
participaciones_menores <- resumen_pruebas  %>%
  filter(grupo_edad == "Menores de 18") %>%
  group_by(tipo_prueba) %>%
  summarise(total_participantes = sum(num_participantes),porcentajes_acumulativos=sum(porcentaje))

print(participaciones_menores)
## # A tibble: 2 × 3
##   tipo_prueba total_participantes porcentajes_acumulativos
##   <chr>                     <int>                    <dbl>
## 1 Explosiva                   217                     7.73
## 2 Resistencia                 116                     4.13

Evidentemente, como ya nos podíamos esperar, la participación de nadadores menores de edad en pruebas explosivas es notablemente mayor que en pruebas de resistencia. Esto se puede atribuir a la naturaleza de las pruebas, donde las pruebas explosivas, como los 50 y 100 metros, requieren menos tiempo de entrenamiento prolongado en comparación con las pruebas de resistencia, que implican una mayor dedicación y condición física a largo plazo.

Estudio sobre la variable round. [Alonso]

A continuación, vamos a intentar entender más sobre la variable ronda. Para ello, primero vemos un resumen:

summary(datos2015$round)
##  FIN  PRE  SEM  SOP  SOS 
## 1474 8846 1022    4   18

Observamos que toma 5 posibles valores, tenemos controlados tanto FIN (final), como PRE (preliminar) y SEM (semifinal). Pero SOP y SOS no parece tan claro saber qué es. Vamos a comenzar dejando de lado SOP y SOS, nos vamos a centrar en controlar los otros 3 valores.

¿Cuántos nadadores nadan cada ronda? [Alonso]

Una pregunta natural podría ser, ¿cuántos nadadores pasan de ronda? ¿Todos? Está claro que al ver que por la mañana en preliminares nadan el 75% y por las tardes son semifinales y finales y son un 25%. Veamoslo con distintas pruebas:

50 libre femenino: [Alonso]

Seleccionamos las nadadoras que nadaron preliminares en el 50 libre femenino:

free50PrelimWomens<- nadadoresPruebas[nadadoresPruebas$round=="PRE" & nadadoresPruebas$distance==50 & nadadoresPruebas$stroke=="FREE" & nadadoresPruebas$gender=="F", ]

head(free50PrelimWomens,10)
##     athleteid           lastname       firstname gender       name code eventid
## 16     105101       TUDO CUBELLS           NADIA      F    Andorra  AND      34
## 18     100518            NOBREGA             ANA      F     Angola  ANG      34
## 51     101948           VASILYAN          MONIKA      F    Armenia  ARM      34
## 58     100557             PONSON ALLYSON ROXANNE      F      Aruba  ARU      34
## 77     100537           CAMPBELL          BRONTE      F  Australia  AUS      34
## 85     100631           CAMPBELL            CATE      F  Australia  AUS      34
## 193    110859        KOSCHISCHEK          BIRGIT      F    Austria  AUT      34
## 205    113565         ALKARAMOVA          FATIMA      F Azerbaijan  AZE      34
## 211    102356 VANDERPOOL-WALLACE         ARIANNA      F    Bahamas  BAH      34
## 222    105108              AKTAR           SONIA      F Bangladesh  BAN      34
##     heat lane points reactiontime swimtime split cumswimtime splitdistance
## 16     5    2    608         0.71    28.00     1       28.00            50
## 18     5    7    607         0.76    28.02     1       28.02            50
## 51     7    8    633         0.78    27.63     1       27.63            50
## 58     7    4    726         0.67    26.40     1       26.40            50
## 77    12    5    882         0.69    24.74     1       24.74            50
## 85    12    4    919         0.82    24.40     1       24.40            50
## 193   12    9    795         0.64    25.61     1       25.61            50
## 205    5    0    577         0.81    28.50     1       28.50            50
## 211   10    5    916         0.61    24.43     1       24.43            50
## 222    2    3    453         0.70    30.89     1       30.89            50
##     daytime round distance stroke splitswimtime edad
## 16      930   PRE       50   FREE         28.00   18
## 18      930   PRE       50   FREE         28.02   24
## 51      930   PRE       50   FREE         27.63   19
## 58      930   PRE       50   FREE         26.40   19
## 77      930   PRE       50   FREE         24.74   21
## 85      930   PRE       50   FREE         24.40   23
## 193     930   PRE       50   FREE         25.61   28
## 205     930   PRE       50   FREE         28.50   13
## 211     930   PRE       50   FREE         24.43   25
## 222     930   PRE       50   FREE         30.89   18

Ahora, vamos a hacer el ranking de resultados de esta prueba, para ello:

free50PrelimWomens<-free50PrelimWomens[order(free50PrelimWomens$swimtime), ]

dim(free50PrelimWomens)
## [1] 115  21

Observamos que hubo 119 nadadoras que nadaron las preliminares del 50 libres. Veamos ahora cuántas nadaron las semifinales:

free50SemisWomens<-nadadoresPruebas[nadadoresPruebas$round=="SEM" & nadadoresPruebas$distance==50 & nadadoresPruebas$stroke=="FREE" & nadadoresPruebas$gender=="F", ]

Antes de ordenarlas, veamos cuántas filas tengo en mi nuevo data frame:

dim(free50SemisWomens)
## [1] 16 21

Es decir, de 119, sólo se clasificaron 16. Veamos si fueron las 16 primeras. Para ello, voy a coger las 16 primeras de las prelims, voy ahora a ordenarlas por athleteid, y hacer lo mismo con las de las semifinales, a ver si coincide:

free50PrelimWomens<-head(free50PrelimWomens, 16)

#Ordeno: 

free50PrelimWomens<-free50PrelimWomens[order(free50PrelimWomens$athleteid), ]
free50SemisWomens<-free50SemisWomens[order(free50SemisWomens$athleteid), ]

free50PrelimWomens
##      athleteid           lastname    firstname gender          name code
## 77      100537           CAMPBELL       BRONTE      F     Australia  AUS
## 85      100631           CAMPBELL         CATE      F     Australia  AUS
## 2423    100728           SJOSTROM        SARAH      F        Sweden  SWE
## 442     101166      VAN LANDEGHEM CHANTAL JEAN      F        Canada  CAN
## 360     101198           MEDEIROS       ETIENE      F        Brazil  BRA
## 741     101408              BLUME     PERNILLE      F       Denmark  DEN
## 1117    101550             BRANDT     DOROTHEA      F       Germany  GER
## 1885    101698       KROMOWIDJOJO       RANOMI      F   Netherlands  NED
## 1023    101764            HALSALL         FRAN      F Great Britain  GBR
## 759     101868            OTTESEN     JEANETTE      F       Denmark  DEN
## 211     102356 VANDERPOOL-WALLACE      ARIANNA      F       Bahamas  BAH
## 2597    105575             MANUEL       SIMONE      F United States  USA
## 958     110207          SANTAMANS         ANNA      F        France  FRA
## 599     110589                LIU        XIANG      F         China  CHN
## 2211    110853           KAMENEVA       MARIIA      F        Russia  RUS
## 487     118570           WILLIAMS     MICHELLE      F        Canada  CAN
##      eventid heat lane points reactiontime swimtime split cumswimtime
## 77        34   12    5    882         0.69    24.74     1       24.74
## 85        34   12    4    919         0.82    24.40     1       24.40
## 2423      34   10    4    905         0.67    24.53     1       24.53
## 442       34   11    2    861         0.71    24.94     1       24.94
## 360       34   11    3    858         0.64    24.97     1       24.97
## 741       34   11    6    841         0.67    25.14     1       25.14
## 1117      34   10    6    885         0.69    24.71     1       24.71
## 1885      34   11    5    895         0.67    24.62     1       24.62
## 1023      34   11    4    876         0.67    24.80     1       24.80
## 759       34   12    3    891         0.65    24.66     1       24.66
## 211       34   10    5    916         0.61    24.43     1       24.43
## 2597      34   10    3    864         0.67    24.91     1       24.91
## 958       34   12    7    865         0.60    24.90     1       24.90
## 599       34   12    8    873         0.76    24.82     1       24.82
## 2211      34   10    8    837         0.68    25.18     1       25.18
## 487       34   11    8    842         0.70    25.13     1       25.13
##      splitdistance daytime round distance stroke splitswimtime edad
## 77              50     930   PRE       50   FREE         24.74   21
## 85              50     930   PRE       50   FREE         24.40   23
## 2423            50     930   PRE       50   FREE         24.53   22
## 442             50     930   PRE       50   FREE         24.94   21
## 360             50     930   PRE       50   FREE         24.97   24
## 741             50     930   PRE       50   FREE         25.14   21
## 1117            50     930   PRE       50   FREE         24.71   31
## 1885            50     930   PRE       50   FREE         24.62   25
## 1023            50     930   PRE       50   FREE         24.80   25
## 759             50     930   PRE       50   FREE         24.66   27
## 211             50     930   PRE       50   FREE         24.43   25
## 2597            50     930   PRE       50   FREE         24.91   19
## 958             50     930   PRE       50   FREE         24.90   22
## 599             50     930   PRE       50   FREE         24.82   18
## 2211            50     930   PRE       50   FREE         25.18   16
## 487             50     930   PRE       50   FREE         25.13   24
free50SemisWomens
##      athleteid           lastname    firstname gender          name code
## 78      100537           CAMPBELL       BRONTE      F     Australia  AUS
## 86      100631           CAMPBELL         CATE      F     Australia  AUS
## 2424    100728           SJOSTROM        SARAH      F        Sweden  SWE
## 443     101166      VAN LANDEGHEM CHANTAL JEAN      F        Canada  CAN
## 361     101198           MEDEIROS       ETIENE      F        Brazil  BRA
## 742     101408              BLUME     PERNILLE      F       Denmark  DEN
## 1118    101550             BRANDT     DOROTHEA      F       Germany  GER
## 1886    101698       KROMOWIDJOJO       RANOMI      F   Netherlands  NED
## 1024    101764            HALSALL         FRAN      F Great Britain  GBR
## 760     101868            OTTESEN     JEANETTE      F       Denmark  DEN
## 212     102356 VANDERPOOL-WALLACE      ARIANNA      F       Bahamas  BAH
## 2598    105575             MANUEL       SIMONE      F United States  USA
## 959     110207          SANTAMANS         ANNA      F        France  FRA
## 600     110589                LIU        XIANG      F         China  CHN
## 2212    110853           KAMENEVA       MARIIA      F        Russia  RUS
## 488     118570           WILLIAMS     MICHELLE      F        Canada  CAN
##      eventid heat lane points reactiontime swimtime split cumswimtime
## 78       234    2    6    928         0.68    24.32     1       24.32
## 86       234    2    4    940         0.79    24.22     1       24.22
## 2424     234    2    5    930         0.67    24.31     1       24.31
## 443      234    1    7    906         0.69    24.52     1       24.52
## 361      234    2    1    852         0.63    25.03     1       25.03
## 742      234    2    8    862         0.67    24.93     1       24.93
## 1118     234    1    3    881         0.73    24.75     1       24.75
## 1886     234    1    5    939         0.70    24.23     1       24.23
## 1024     234    1    6    908         0.67    24.50     1       24.50
## 760      234    2    3    896         0.65    24.61     1       24.61
## 212      234    1    4    922         0.62    24.38     1       24.38
## 2598     234    2    7    911         0.66    24.47     1       24.47
## 959      234    1    2    862         0.60    24.93     1       24.93
## 600      234    2    2    878         0.73    24.78     1       24.78
## 2212     234    1    8    858         0.69    24.97     1       24.97
## 488      234    1    1    871         0.68    24.84     1       24.84
##      splitdistance daytime round distance stroke splitswimtime edad
## 78              50    1828   SEM       50   FREE         24.32   21
## 86              50    1828   SEM       50   FREE         24.22   23
## 2424            50    1828   SEM       50   FREE         24.31   22
## 443             50    1828   SEM       50   FREE         24.52   21
## 361             50    1828   SEM       50   FREE         25.03   24
## 742             50    1828   SEM       50   FREE         24.93   21
## 1118            50    1828   SEM       50   FREE         24.75   31
## 1886            50    1828   SEM       50   FREE         24.23   25
## 1024            50    1828   SEM       50   FREE         24.50   25
## 760             50    1828   SEM       50   FREE         24.61   27
## 212             50    1828   SEM       50   FREE         24.38   25
## 2598            50    1828   SEM       50   FREE         24.47   19
## 959             50    1828   SEM       50   FREE         24.93   22
## 600             50    1828   SEM       50   FREE         24.78   18
## 2212            50    1828   SEM       50   FREE         24.97   16
## 488             50    1828   SEM       50   FREE         24.84   24

Luego, podemos observar claramente que, las 16 primeras de las preliminares, consiguieron clasificarse a las semifinales. Hagamos el mismo trabajo con el dataframe free50SemisWomens para ver cuántas nadadoras se clasificaron en la final:

free50SemisWomens<-free50SemisWomens[order(free50SemisWomens$swimtime), ]

Al igual que antes, confeccionamos el dataframe de la final:

free50FinalWomens<-nadadoresPruebas[nadadoresPruebas$round=="FIN" & nadadoresPruebas$distance==50 & nadadoresPruebas$stroke=="FREE" & nadadoresPruebas$gender=="F", ]

dim(free50FinalWomens)
## [1]  8 21

Observamos que hay 8, luego las 8 primeras se clasificaron a la final.

¿Se nadan las 3 rondas en cada prueba?(ALONSO)

Esta cuestión nos surge ya que, algunas pruebas requieren más esfuerzo y el tiempo de descanso para la recuperación total es más largo, por ello alomejor hay pruebas en las que sólo hay 1 ronda, o 2, o esta suposición es falsa y en cada prueba se nadan 3 rondas. Para ello, echemos un cálculo inicial. Hay 2 géneros, pruebas de 50, 100, 200, 400, 800 y 1500 metros. Veamos qué valores toman las rondas en cada una de estas pruebas. Para ello:

print("Rondas que se nadan en las pruebas de 50 metros: ")
## [1] "Rondas que se nadan en las pruebas de 50 metros: "
summary(nadadoresPruebas[nadadoresPruebas$distance==50, ]$round)
## FIN PRE SEM SOP SOS 
##  64 646 128   0   2
print("Rondas que se nadan en las pruebas de 100 metros:")
## [1] "Rondas que se nadan en las pruebas de 100 metros:"
summary(nadadoresPruebas[nadadoresPruebas$distance==100, ]$round)
## FIN PRE SEM SOP SOS 
##  64 628 128   2   0
print("Rondas que se nadan en las pruebas de 200 metros:")
## [1] "Rondas que se nadan en las pruebas de 200 metros:"
summary(nadadoresPruebas[nadadoresPruebas$distance==200, ]$round)
## FIN PRE SEM SOP SOS 
##  80 490 160   0   4
print("Rondas que se nadan en las pruebas de 400 metros:")
## [1] "Rondas que se nadan en las pruebas de 400 metros:"
summary(nadadoresPruebas[nadadoresPruebas$distance==400, ]$round)
## FIN PRE SEM SOP SOS 
##  32 193   0   0   0
print("Rondas que se nadan en las pruebas de 800 metros:")
## [1] "Rondas que se nadan en las pruebas de 800 metros:"
summary(nadadoresPruebas[nadadoresPruebas$distance==800, ]$round)
## FIN PRE SEM SOP SOS 
##  16  84   0   0   0
print("Rondas que se nadan en las pruebas de 1500 metros:")
## [1] "Rondas que se nadan en las pruebas de 1500 metros:"
summary(nadadoresPruebas[nadadoresPruebas$distance==1500, ]$round)
## FIN PRE SEM SOP SOS 
##  15  70   0   0   0

Luego, observamos que en las pruebas de 400, 800 y 1500 metros no hay semifinales, tan sólo una ronda preliminar y una ronda final.

También podemos sacar conclusiones gracias al estudio hecho en el apartado anterior. En los 50 por ejemplo, hay 128 nadadores que nadan semifinales, hay dos géneros, luego 64 nadadores por género nadaron semifinales, además, hay 4 estilos, luego 16 nadadores nadaron las semifinales de cada prueba, lo cual concuerda con lo visto anteriormente.

Destaca a la vista que, en las pruebas de 200 metros, hay más nadadores. ¿Por qué sucede esto?. Veamos:

print("Estilos que se nadan en pruebas de 50 metros: ")
## [1] "Estilos que se nadan en pruebas de 50 metros: "
summary(nadadoresPruebas[nadadoresPruebas$distance==50, ]$stroke)
##   BACK BREAST    FLY   FREE MEDLEY 
##    169    200    192    279      0
print("Estilos que se nadan en pruebas de 200 metros:")
## [1] "Estilos que se nadan en pruebas de 200 metros:"
summary(nadadoresPruebas[nadadoresPruebas$distance==200, ]$stroke)
##   BACK BREAST    FLY   FREE MEDLEY 
##    129    152    127    190    136

Hay más nadadores que nadan semifinales puesto que hay 5 pruebas, no 4. Si echamos los cálculos, 160/(2*5)=16 nadadores, igual que en las demás.

Se puede ver de manera análoga que nadan 8 nadadores cada final.

Ahora, ya que hemos analizado a fondo qué sucede con las finales, semifinales y preliminares, vamos a ver qué significan los otros dos valores que toma la variable round.

Rondas SOP [Alonso]

Bien, primeramente, vamos a observar las filas tales que toman ese valor. Lo hacemos de la siguiente manera:

datosSOP<-datos2015[datos2015$round=="SOP",]

datosSOP
##      athleteid lastname           firstname gender          name code eventid
## 3220    101910    OSMAN FARIDA HISHAM AHMED      F         Egypt  EGY     301
## 3221    101910    OSMAN FARIDA HISHAM AHMED      F         Egypt  EGY     301
## 4448    120441    KELLY   RACHAEL ELIZABETH      F Great Britain  GBR     301
## 4449    120441    KELLY   RACHAEL ELIZABETH      F Great Britain  GBR     301
##      heat lane points reactiontime swimtime split cumswimtime splitdistance
## 3220    1    5    888         0.72    58.22     1       27.29            50
## 3221    1    5    888         0.72    58.22     2       58.22           100
## 4448    1    4    891         0.66    58.17     1       27.60            50
## 4449    1    4    891         0.66    58.17     2       58.17           100
##      daytime round distance stroke splitswimtime edad
## 3220    1156   SOP      100    FLY         27.29   20
## 3221    1156   SOP      100    FLY         30.93   20
## 4448    1156   SOP      100    FLY         27.60   21
## 4449    1156   SOP      100    FLY         30.57   21

Observamos 4 filas, que se trata, viendo que es el mismo eventid, de una prueba que nadan sólo 2 nadadoras, Osman y Kelly. En este caso, un 100 mariposa. Es curioso que estas dos nadadoras naden una sóla prueba. Además, nadaron a las 11:56, por la mañana, donde sólo se nadan preliminares. Vamos a ver si descubrimos algo viendo la clasificación de ese 100 mariposa en la ronda preliminar:

fly100PREWomen<-nadadoresPruebas[nadadoresPruebas$distance==100 & nadadoresPruebas$stroke=="FLY" & nadadoresPruebas$round=="PRE" & nadadoresPruebas$gender=="F", ]

#Ahora ordenamos por tiempo
fly100PREWomen<-fly100PREWomen[order(fly100PREWomen$swimtime), ]
#Las ordeno
rownames(fly100PREWomen) <- 1:nrow(fly100PREWomen)
head(fly100PREWomen,20)
##    athleteid lastname           firstname gender          name code eventid
## 1     100728 SJOSTROM               SARAH      F        Sweden  SWE       1
## 2     101868  OTTESEN            JEANETTE      F       Denmark  DEN       1
## 3     101955   DEKKER                INGE      F   Netherlands  NED       1
## 4     102558       LU                YING      F         China  CHN       1
## 5     101207   SAVARD            KATERINE      F        Canada  CAN       1
## 6     101905     WENK  ALEXANDRA NATHALIE      F       Germany  GER       1
## 7     105628  STEWART              KENDYL      F United States  USA       1
## 8     100650   MCKEON                EMMA      F     Australia  AUS       1
## 9     100399       AN             SEHYEON      F         Korea  KOR       1
## 10    105257   GROVES            MADELINE      F     Australia  AUS       1
## 11    102476     CHEN               XINYI      F         China  CHN       1
## 12    100611   THOMAS              NOEMIE      F        Canada  CAN       1
## 13    100896     BUYS            KIMBERLY      F       Belgium  BEL       1
## 14    101847  BIANCHI              ILARIA      F         Italy  ITA       1
## 15    100505    HOSHI             NATSUMI      F         Japan  JPN       1
## 16    101910    OSMAN FARIDA HISHAM AHMED      F         Egypt  EGY       1
## 17    120441    KELLY   RACHAEL ELIZABETH      F Great Britain  GBR       1
## 18    100567 DE PAULA             DAYNARA      F        Brazil  BRA       1
## 19    102246     LOWE        JEMMA LOUISE      F Great Britain  GBR       1
## 20    105661  DONAHUE              CLAIRE      F United States  USA       1
##    heat lane points reactiontime swimtime split cumswimtime splitdistance
## 1     7    4    974         0.67    56.47     1       26.54            50
## 2     6    4    908         0.70    57.79     1       26.80            50
## 3     5    5    907         0.70    57.82     1       26.37            50
## 4     7    2    906         0.72    57.84     1       26.92            50
## 5     5    4    900         0.67    57.96     1       26.91            50
## 6     6    7    896         0.68    58.05     1       27.57            50
## 7     5    6    896         0.76    58.06     1       26.39            50
## 8     7    5    893         0.77    58.12     1       27.21            50
## 9     7    1    888         0.69    58.24     1       27.19            50
## 10    6    5    884         0.75    58.31     1       27.41            50
## 11    6    6    883         0.73    58.34     1       27.50            50
## 12    7    7    883         0.63    58.35     1       26.93            50
## 13    7    8    882         0.75    58.36     1       26.95            50
## 14    6    3    882         0.66    58.37     1       27.13            50
## 15    7    0    877         0.64    58.47     1       27.59            50
## 16    6    9    877         0.74    58.48     1       26.94            50
## 17    5    3    877         0.70    58.48     1       27.40            50
## 18    5    1    872         0.65    58.59     1       27.50            50
## 19    5    2    865         0.67    58.74     1       27.51            50
## 20    6    2    864         0.71    58.77     1       26.72            50
##    daytime round distance stroke splitswimtime edad
## 1      930   PRE      100    FLY         26.54   22
## 2      930   PRE      100    FLY         26.80   27
## 3      930   PRE      100    FLY         26.37   30
## 4      930   PRE      100    FLY         26.92   26
## 5      930   PRE      100    FLY         26.91   22
## 6      930   PRE      100    FLY         27.57   20
## 7      930   PRE      100    FLY         26.39   21
## 8      930   PRE      100    FLY         27.21   21
## 9      930   PRE      100    FLY         27.19   19
## 10     930   PRE      100    FLY         27.41   20
## 11     930   PRE      100    FLY         27.50   17
## 12     930   PRE      100    FLY         26.93   19
## 13     930   PRE      100    FLY         26.95   26
## 14     930   PRE      100    FLY         27.13   25
## 15     930   PRE      100    FLY         27.59   25
## 16     930   PRE      100    FLY         26.94   20
## 17     930   PRE      100    FLY         27.40   21
## 18     930   PRE      100    FLY         27.50   26
## 19     930   PRE      100    FLY         27.51   25
## 20     930   PRE      100    FLY         26.72   26

Si busco a Osman y Kelly en el anterior dataframe, observo que se encuentran en el puesto 16 y 17 respectivamente y que, hicieron el mismo tiempo. Luego tiene sentido razonar que, las rondas SOP son rondas de desempate para ver quién pasa a la siguiente ronda.

Rondas SOS [Alonso]

Viendo el razonamiento de las rondas SOP, intuimos que las rondas SOS deben ser rondas de desempate entre nadadores de las semifinales. De todas maneras, vamos a verlo. Para ello, si nos fijamos en una de los dataframes anteriores, en la prueba de 200 metros había 4 nadadores que nadan la ronda SOS. Vamos a visualizarlo:

datosSOS<-nadadoresPruebas[nadadoresPruebas$round=="SOS" & nadadoresPruebas$distance==200, ]
datosSOS
##      athleteid      lastname   firstname gender          name code eventid heat
## 528     102550           SHI     JINGLIN      F         China  CHN     425    1
## 1010    101595        PAVONI     ROBERTO      M Great Britain  GBR     421    1
## 1368    100918 LUTHERSDOTTIR HRAFNHILDUR      F       Iceland  ISL     425    1
## 2605    105576         DWYER       CONOR      M United States  USA     421    1
##      lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 528     4    906         0.74   143.75     1       33.66            50    1943
## 1010    5    895         0.66   118.26     1       25.81            50    1942
## 1368    5    881         0.71   145.11     1       32.79            50    1943
## 2605    4    897         0.66   118.18     1       25.27            50    1942
##      round distance stroke splitswimtime edad
## 528    SOS      200 BREAST         33.66   22
## 1010   SOS      200 MEDLEY         25.81   24
## 1368   SOS      200 BREAST         32.79   24
## 2605   SOS      200 MEDLEY         25.27   26

Vemos que se nadaron dos rondas SOS, una para la prueba de 200m braza femenino, y otra para la prueba de 200 estilos masculino. Elijamos el 200 estilos masculino, visualicemos el ranking de las semifinales y veamos si están Roberto Pavoni y Conor Dwyer empatados en el 8vo y 9no puesto:

medley200SEM<-nadadoresPruebas[nadadoresPruebas$round=="SEM" & nadadoresPruebas$distance==200 & nadadoresPruebas$gender=="M" & nadadoresPruebas$stroke=="MEDLEY", ]

#Ahora, ordeno igual que antes: 

medley200SEM<-medley200SEM[order(medley200SEM$swimtime), ]
#Las ordeno
rownames(medley200SEM) <- 1:nrow(medley200SEM)
medley200SEM
##    athleteid      lastname              firstname gender          name code
## 1     105655        LOCHTE                   RYAN      M United States  USA
## 2     103260          WANG                   SHUN      M         China  CHN
## 3     100891       PEREIRA                 THIAGO      M        Brazil  BRA
## 4     101437       WALLACE            DANIEL JOHN      M Great Britain  GBR
## 5     101240        SJODIN                  SIMON      M        Sweden  SWE
## 6     110224       CIESLAK                 MARCIN      M        Poland  POL
## 7     101164     RODRIGUES               HENRIQUE      M        Brazil  BRA
## 8     101595        PAVONI                ROBERTO      M Great Britain  GBR
## 9     105576         DWYER                  CONOR      M United States  USA
## 10    101229 FRASER-HOLMES                 THOMAS      M     Australia  AUS
## 11    100840     TOUMARKIN              YAKOV YAN      M        Israel  ISR
## 12    105209   DESPLANCHES                 JEREMY      M   Switzerland  SUI
## 13    110782       VAZAIOS                ANDREAS      M        Greece  GRE
## 14    100478          SETO                  DAIYA      M         Japan  JPN
## 15    100980      CARVALHO                  DIOGO      M      Portugal  POR
## 16    101493       HUSSEIN MOHAMED KHALED MOHAMED      M         Egypt  EGY
##    eventid heat lane points reactiontime swimtime split cumswimtime
## 1      221    2    4    929         0.68   116.81     1       24.80
## 2      221    2    5    923         0.64   117.07     1       24.91
## 3      221    1    6    917         0.69   117.33     1       25.23
## 4      221    1    4    907         0.71   117.77     1       25.27
## 5      221    1    7    899         0.70   118.10     1       25.40
## 6      221    2    8    897         0.69   118.20     1       25.63
## 7      221    1    3    891         0.70   118.45     1       25.63
## 8      221    2    2    889         0.67   118.54     1       26.10
## 9      221    1    5    889         0.65   118.54     1       25.51
## 10     221    2    1    882         0.67   118.83     1       24.87
## 11     221    1    1    882         0.77   118.86     1       25.08
## 12     221    1    2    871         0.65   119.35     1       25.56
## 13     221    2    3    867         0.70   119.53     1       25.99
## 14     221    2    6    856         0.62   120.05     1       25.77
## 15     221    2    7    850         0.70   120.31     1       25.92
## 16     221    1    8    827         0.74   121.41     1       25.98
##    splitdistance daytime round distance stroke splitswimtime edad
## 1             50    1845   SEM      200 MEDLEY         24.80   31
## 2             50    1845   SEM      200 MEDLEY         24.91   21
## 3             50    1845   SEM      200 MEDLEY         25.23   29
## 4             50    1845   SEM      200 MEDLEY         25.27   22
## 5             50    1845   SEM      200 MEDLEY         25.40   28
## 6             50    1845   SEM      200 MEDLEY         25.63   23
## 7             50    1845   SEM      200 MEDLEY         25.63   24
## 8             50    1845   SEM      200 MEDLEY         26.10   24
## 9             50    1845   SEM      200 MEDLEY         25.51   26
## 10            50    1845   SEM      200 MEDLEY         24.87   23
## 11            50    1845   SEM      200 MEDLEY         25.08   23
## 12            50    1845   SEM      200 MEDLEY         25.56   21
## 13            50    1845   SEM      200 MEDLEY         25.99   21
## 14            50    1845   SEM      200 MEDLEY         25.77   21
## 15            50    1845   SEM      200 MEDLEY         25.92   27
## 16            50    1845   SEM      200 MEDLEY         25.98   23

Y efectivamente, empataron con un tiempo de 118.54 segundos, luego SOS equivale a las rondas de desempate producidas en las rondas semifinales. Además, observamos que se realizan por las tardes.

Luego, ya hemos resuelto las dudas acerca de Round.

Estudios relacionados con los puntos(Javi).

Veamos las posibles relaciones de puntos con las demás variables:

Antes de ello, vamos a tener que eliminar de este estudio a los nadadores descalificados (es decir, los que tienen NA points).

nadadoresPruebas <- nadadoresPruebas %>% filter(!is.na(nadadoresPruebas$points))

Mejor nadador por prueba nadada. MVP de los mundiales(Javi).

Veamos ahora cómo se distribuyen los puntos.

ggplot(nadadoresPruebas, aes(x = points)) +
geom_density() +
ggtitle("Distribución. points")

Observamos que la mayoría de puntos se encuentran a partir de los 750/800 puntos, y esto, tiene sentido si razonamos que para entrar a los mundiales de natación, se necesitan unas marcas mínimas (una cantidad de puntos preestablecida). Luego es normal encontrar una gran cantidad de datos que tengan más de 750 puntos ya que había un “corte” para la inscripción en la competición. Esto hace que la gráfica no esté más distribuida por todos los posibles valores de puntos.

Ahora nos surge la siguiente pregunta: ¿Quién rindió mejor en los campeonatos?.

Podemos buscar el nadador que hizo más puntos:

datos2015[which.max(datos2015$points), ]
##       athleteid lastname firstname gender          name code eventid heat lane
## 10558    105594  LEDECKY     KATIE      F United States  USA     113    1    4
##       points reactiontime swimtime split cumswimtime splitdistance daytime
## 10558   1028          0.7   925.48     1       28.37            50    1805
##       round distance stroke splitswimtime edad
## 10558   FIN     1500   FREE         28.37   18

Observamos que la nadadora que cosechó más puntos en una prueba fue Katie Ledecky en los 1500 metros. Buscando, casualmente observamos que batió el récord[https://www.rtve.es/deportes/20150803/ledecky-bate-record-del-mundo-1500-libres/1193160.shtml] del mundo en dicha prueba.

Ahora, vamos a buscar al nadador que, en promedio, consiguió más puntos, podríamos denominarlo el MVP del Mundial Kazán 2015. Para ello:

#Usamos nadadoresPruebas, donde tenemos cada nadador y la prueba que realizó. 

media_puntos <- aggregate(nadadoresPruebas$points ~ nadadoresPruebas$athleteid, data = nadadoresPruebas, FUN = mean)
media_puntos <- media_puntos[order(media_puntos$`nadadoresPruebas$points`, decreasing = TRUE), ]
media_puntos<- rename(media_puntos, "athleteid"="nadadoresPruebas$athleteid")
media_puntos<-rename(media_puntos, "meanPoints"="nadadoresPruebas$points")

head(media_puntos,5)
##     athleteid meanPoints
## 666    108588   985.5714
## 452    102630   978.2857
## 554    105594   973.1111
## 222    101365   967.3333
## 76     100728   966.7500

El atleta con id 108588 es el que hizo más puntos, veamos quien es:

nadadoresPruebas[nadadoresPruebas$athleteid==108588 , ]
##      athleteid lastname firstname gender          name code eventid heat lane
## 1048    108588    PEATY      ADAM      M Great Britain  GBR       6    9    4
## 1049    108588    PEATY      ADAM      M Great Britain  GBR     206    2    4
## 1050    108588    PEATY      ADAM      M Great Britain  GBR     106    1    4
## 1051    108588    PEATY      ADAM      M Great Britain  GBR      14    9    4
## 1052    108588    PEATY      ADAM      M Great Britain  GBR     214    1    4
## 1053    108588    PEATY      ADAM      M Great Britain  GBR     114    1    4
## 1054    108588    PEATY      ADAM      M Great Britain  GBR      26    5    5
##      points reactiontime swimtime split cumswimtime splitdistance daytime round
## 1048    996         0.60    58.52     1       27.05            50    1134   PRE
## 1049   1014         0.60    58.18     1       27.21            50    1835   SEM
## 1050    996         0.59    58.52     1       27.20            50    1732   FIN
## 1051    993         0.60    26.68     1       26.68            50     930   PRE
## 1052   1022         0.59    26.42     1       26.42            50    1748   SEM
## 1053   1012         0.57    26.51     1       26.51            50    1810   FIN
## 1054    866         0.61   133.24     1       29.77            50    1033   PRE
##      distance stroke splitswimtime edad
## 1048      100 BREAST         27.05   20
## 1049      100 BREAST         27.21   20
## 1050      100 BREAST         27.20   20
## 1051       50 BREAST         26.68   20
## 1052       50 BREAST         26.42   20
## 1053       50 BREAST         26.51   20
## 1054      200 BREAST         29.77   20

Luego, el MVP fue el británico Adam Peaty, que nadó 50, 100 y 200 braza. Veamos quiénes fueron los integrantes del podio:

nadadoresParticipantes[nadadoresParticipantes$athleteid==102630 | nadadoresParticipantes$athleteid==105594, ]
##      athleteid      lastname firstname gender          name code eventid heat
## 839     102630 VAN DER BURGH   CAMERON      M  South Africa  RSA       6    8
## 1036    105594       LEDECKY     KATIE      F United States  USA       5    5
##      lane points reactiontime swimtime split cumswimtime splitdistance daytime
## 839     5    993         0.63    58.59     1       27.11            50    1134
## 1036    4    964         0.69   241.73     1       27.79            50    1103
##      round distance stroke splitswimtime edad
## 839    PRE      100 BREAST         27.11   27
## 1036   PRE      400   FREE         27.79   18

Completaron el podio Cameron Van der Burgh, de Sudáfrica, y Katie Ledecky.

Puntos. Hombres vs Mujeres(Ines)

A continuación, vamos a comparar los puntos realizados por hombres y mujeres, para ver si podemos sacar alguna conclusión.

Primeramente, vamos a ver la función de densidad:

ggplot(nadadoresPruebas, aes(x = points, colour=gender)) +
geom_density() +
ggtitle("Distribución. Puntos por sexo")

A priori, parece haber dos distribuciones muy igualadas.

modelo= lm(points ~ gender, data = nadadoresParticipantes)

summary(modelo)
## 
## Call:
## lm(formula = points ~ gender, data = nadadoresParticipantes)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -708.38  -68.98   48.62  112.43  235.62 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  742.569      7.062 105.153   <2e-16 ***
## genderM       17.812      9.500   1.875   0.0611 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 156.3 on 1093 degrees of freedom
##   (4 observations deleted due to missingness)
## Multiple R-squared:  0.003206,   Adjusted R-squared:  0.002294 
## F-statistic: 3.515 on 1 and 1093 DF,  p-value: 0.06107
# Realizar ANOVA
anova_puntos_genero <- aov(points ~ gender, data = nadadoresParticipantes)

# Ver el resumen del resultado
summary(anova_puntos_genero)
##               Df   Sum Sq Mean Sq F value Pr(>F)  
## gender         1    85898   85898   3.515 0.0611 .
## Residuals   1093 26708403   24436                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 4 observations deleted due to missingness

Puntos. ¿La edad influye?(Salma)

Una buena manera de medir el rendimiento con respecto a la edad del nadador, es verlo a través de los puntos obtenidos.

# Resumen de puntos por edad
resumen_puntos <- nadadoresPruebas %>%
  group_by(edad, points) %>%
  summarise(frecuencia = n(), .groups = 'drop')

# Crear el gráfico de calor
ggplot(resumen_puntos, aes(x = edad, y = points)) +
  geom_tile(aes(fill = frecuencia), color = "black") +
  # Usar una paleta de colores divergente
  scale_fill_gradientn(colors = brewer.pal(9, "Reds"), 
                       limits = c(min(resumen_puntos$frecuencia), max(resumen_puntos$frecuencia))) + 
  theme_bw() +
  labs(title = "Gráfico de Calor: Edades y Puntos Obtenidos",
       x = "Edad",
       y = "Puntos Obtenidos") +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

# Crear una nueva columna que clasifica a los nadadores en grupos de edad
nadadoresPruebas <- nadadoresPruebas %>%
  mutate(grupo_edad = case_when(
    edad < 18 ~ "Menores de 18",
    edad >= 18 & edad <= 30 ~ "Entre 18 y 30",
    edad > 30 ~ "Mayores de 30"
  ))

# Calcular el promedio de puntos por grupo de edad
promedio_puntos <- nadadoresPruebas %>%
  group_by(grupo_edad) %>%
  summarise(promedio = mean(points, na.rm = TRUE))

# Crear un gráfico de barras para visualizar el promedio de puntos
ggplot(promedio_puntos, aes(x = grupo_edad, y = promedio, fill = grupo_edad)) +
  geom_bar(stat = "identity", color = "black") +
  scale_fill_brewer(palette = "Reds") +  # Cambiar la paleta si es necesario
  theme_bw() +
  labs(title = "Promedio de Puntos por Grupo de Edad",
       x = "Grupo de Edad",
       y = "Promedio de Puntos") +
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        legend.position = "none")

Vamos a comparar los puntos con la edad. Para ello, vamos a dividir en 3 grupos por edades (menores de 18, entre 18 y 30 y mayores de 30) y a comparar el promedio de puntos cosechados por cada franja de edad.

# Mostrar el promedio de puntos en una tabla
promedio_puntos %>%
  kable(caption = "Promedio de Puntos por Grupo de Edad", 
        col.names = c("Grupo de Edad", "Promedio de Puntos"))
Promedio de Puntos por Grupo de Edad
Grupo de Edad Promedio de Puntos
Entre 18 y 30 817.7603
Mayores de 30 806.3182
Menores de 18 621.3576

En el grupo de edad entre 18 y 30, el promedio de Puntos es 817.76.Este grupo presenta el promedio más alto en comparación con los otros grupos. Esto podría indicar que los nadadores en este rango de edad tienen un rendimiento superior en términos de puntos acumulados. Esto puede ser atribuible a varios factores, como una mayor experiencia. El grupo de Edad Mayores de 30 tiene un promedio de 806.32 puntos. Los nadadores mayores de 30 años tienen un promedio de puntos ligeramente inferior al grupo de 18 a 30 años. Sin embargo, el rendimiento sigue siendo fuerte, lo que sugiere que, aunque pueden enfrentar desafíos relacionados con la edad, muchos continúan siendo competitivos. El grupo de Edad Menores de 18 tiene un promedio de 621.36 puntos. Este grupo muestra el promedio más bajo en comparación con los otros dos. Esto puede ser indicativo de que los nadadores jóvenes aún están en desarrollo y adquiriendo habilidades y experiencia. Es natural que los nadadores más jóvenes, al estar en una etapa temprana de su carrera, acumulen menos puntos.

La diferencia significativa en el rendimiento entre los grupos puede sugerir que la edad tiene un impacto positivo en el rendimiento de los nadadores, al menos hasta cierto punto. Esto también resalta la importancia del entrenamiento y la experiencia que se adquiere con la edad. Es posible que los nadadores más jóvenes tengan que enfocarse en su desarrollo técnico y competitivo para alcanzar a sus contrapartes mayores. Esto podría incluir mejorar sus técnicas de natación, preparación física, y estrategias de carrera.

Realizamos un test para ver si la diferencia es significativa

# Realiza la prueba de Kruskal-Wallis
kruskal_result <- kruskal.test(points ~ grupo_edad, data = nadadoresPruebas)
print(kruskal_result)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  points by grupo_edad
## Kruskal-Wallis chi-squared = 395.98, df = 2, p-value < 2.2e-16

El p-value < 2.2e-16: Este valor p es extremadamente bajo, lo que indica que hay diferencias significativas en los puntos entre al menos uno de los grupos de edad. Dado que el valor p es muy pequeño, puedes rechazar la hipótesis nula, que sostiene que no hay diferencias en las medianas de los puntos entre los grupos.

Aunque Kruskal-Wallis indica que hay diferencias, no te dice cuáles son esos grupos que difieren. Por lo tanto, es recomendable realizar pruebas post-hoc para identificar qué grupos son significativamente diferentes entre sí.

# Prueba de Dunn
dunn_test <- dunnTest(points ~ grupo_edad, data = nadadoresPruebas, method = "bonferroni")
print(dunn_test)
## Dunn (1964) Kruskal-Wallis multiple comparison
##   p-values adjusted with the Bonferroni method.
##                      Comparison          Z      P.unadj        P.adj
## 1 Entre 18 y 30 - Mayores de 30  0.5939984 5.525132e-01 1.000000e+00
## 2 Entre 18 y 30 - Menores de 18 19.8965938 4.355397e-88 1.306619e-87
## 3 Mayores de 30 - Menores de 18  6.7119013 1.921047e-11 5.763140e-11

Entre 18 y 30 vs. Mayores de 30: No hay evidencia suficiente para afirmar que hay una diferencia significativa en los puntos entre estos dos grupos de edad. Entre 18 y 30 vs. Menores de 18: Hay una diferencia altamente significativa en los puntos entre estos dos grupos. Esto indica que los nadadores menores de 18 años obtienen significativamente menos puntos que los nadadores entre 18 y 30. Mayores de 30 vs. Menores de 18: También hay una diferencia altamente significativa entre estos grupos, sugiriendo que los nadadores mayores de 30 años obtienen significativamente más puntos que los nadadores menores de 18.

La comparación muestra que, mientras que no hay diferencia significativa entre los grupos de 18-30 y mayores de 30, los menores de 18 años se desempeñan significativamente peor en términos de puntos en comparación con ambos grupos de mayores edad.

ggplot(nadadoresPruebas, aes(x = grupo_edad, y = points, fill = grupo_edad)) +
  geom_boxplot() +
  labs(title = "Distribución de Puntos por Grupo de Edad", 
       x = "Grupo de Edad", 
       y = "Puntos") +
  theme_minimal()

Modelo de regresión lineal: reactiontime vs swimtime(Salma)

Empezamos viendo la relación lineal (que ya sabemos que será alta) entre puntos y tiempo. Es evidente que a mayor tiempo, hay menos puntos. Veámoslo

nadadoresPruebas50crol<- nadadoresPruebas[nadadoresPruebas$distance==50 & nadadoresPruebas$stroke=='FREE', ]
t= nadadoresPruebas50crol$swimtime
p= nadadoresPruebas50crol$points
cor(nadadoresPruebas50crol$swimtime,nadadoresPruebas50crol$points)
## [1] NA
head(nadadoresPruebas50crol,10)
##    athleteid      lastname       firstname gender              name code
## 8     115671         HOXHA           SIDNI      M           Albania  ALB
## 16    105101  TUDO CUBELLS           NADIA      F           Andorra  AND
## 18    100518       NOBREGA             ANA      F            Angola  ANG
## 22    120735        AGUIAR            JOAO      M            Angola  ANG
## 23    101069 MASCOLL-GOMES            NOAH      M Antigua & Barbuda  ANT
## 51    101948      VASILYAN          MONIKA      F           Armenia  ARM
## 53    102199    MKHITARYAN           VAHAN      M           Armenia  ARM
## 58    100557        PONSON ALLYSON ROXANNE      F             Aruba  ARU
## 60    105498    SCHREUDERS           MIKEL      M             Aruba  ARU
## 77    100537      CAMPBELL          BRONTE      F         Australia  AUS
##    eventid heat lane points reactiontime swimtime split cumswimtime
## 8       28    8    5    758         0.68    22.93     1       22.93
## 16      34    5    2    608         0.71    28.00     1       28.00
## 18      34    5    7    607         0.76    28.02     1       28.02
## 22      28    6    9    626         0.76    24.44     1       24.44
## 23      28    4    3    600         0.70    24.79     1       24.79
## 51      34    7    8    633         0.78    27.63     1       27.63
## 53      28    7    2    717         0.71    23.36     1       23.36
## 58      34    7    4    726         0.67    26.40     1       26.40
## 60      28    7    8    670         0.69    23.89     1       23.89
## 77      34   12    5    882         0.69    24.74     1       24.74
##    splitdistance daytime round distance stroke splitswimtime edad
## 8             50     930   PRE       50   FREE         22.93   23
## 16            50     930   PRE       50   FREE         28.00   18
## 18            50     930   PRE       50   FREE         28.02   24
## 22            50     930   PRE       50   FREE         24.44   31
## 23            50     930   PRE       50   FREE         24.79   16
## 51            50     930   PRE       50   FREE         27.63   19
## 53            50     930   PRE       50   FREE         23.36   19
## 58            50     930   PRE       50   FREE         26.40   19
## 60            50     930   PRE       50   FREE         23.89   16
## 77            50     930   PRE       50   FREE         24.74   21

Esto no es de mucho estudio, ya que es lo lógico.

Veamos los puntos respecto al tiempo de reacción:

nadadoresPruebas<- na.omit(nadadoresPruebas)
x= nadadoresPruebas$points
y=nadadoresPruebas$reactiontime
cor(x,y)
## [1] -0.2861291

Parecen no estar correlacionadas el tiempo de reaccion y los puntos de manera lineal. Pero a lo mejor, en pruebas específicas , como las pruebas de distancias cortas la correlación es mayor.

nadadoresPruebas50<- nadadoresPruebas[nadadoresPruebas$distance==50, ]
X=nadadoresPruebas50$reactiontime
Y=nadadoresPruebas50$points
cor(X,Y)
## [1] -0.5573374

Ya tenemos nuestro objetivo de estudio ya que para comenzar con la modelización estadística, debemos contextualizar el problema, definiendo objetivos y variables.

Queremos investigar si existe relación entre el tiempo de reacción y puntos. Una pregunta que puede surgirnos es, ¿A mayores valores del tiempo de reacción, hay mayores valores de puntos? Luego, nuestro objetivo será saber si hay algún tipo de relación lineal, y las variables, por ende, serán tiempo de reacción y puntos. La variable tiempo de reacción, será nuestra variable independiente, y puntos será la variable dependiente.

A continuación, procedemos a realizar una inspección gráfica simple, para identificar tendencias.

plot(X,Y,xlab="Tiempo de reacción",ylab="Puntos")

cov(X,Y)
## [1] -6.859023

Esta covarianza, positiva y grande en valor absoluto, nos indica que hay relación negativa entre las variables(ya lo habíamos intuido pero gracias al signo lo hemos confirmado).

A pesar de la confirmación, en este momento nos surge un problema, pues, la covarianza toma valores en todos los números reales, dependiendo de las magnitudes del tiempo de reacción y puntos, y de sus unidades . Por eso, calcularemos el coeficiente de correlación lineal, que se obtiene tipificando la covarianza, es decir, dividiendo la covarianza entre las desviaciones típicas muestrales (obteniendo un coeficiente entre -1 y 1)

cor(X,Y)
## [1] -0.5573374

De manera adicional, podemos incluir histogramas marginales en cada eje del gráfico, para ello usamos las librerías ggplot2 y ggExtra.

datos<-data.frame(x=X,y=Y)

p<-ggplot(datos, aes(x = X, y = Y)) +
  geom_point()
#vemos la nube de puntos 
print(p)
#Especificamos que se añadan histogramas en los márgenes
ggMarginal(p, type = "histogram")

Como hemos visto, si la relacion lineal es fuerte tiene sentido querer ajustar una recta a la nube de puntos. Es decir, considerar un modelo de regresion lineal simple.

La función que ajusta el modelo de regresión lineal simple en R es lm(con parametros B_0,B_1 y sigma^2), directamente hacemos un summary para que nos devuelva la información más importante, aunque realmente lm calcula muchas cosas: estimaciones, residuos, predicciones, etc.

lm=lm(Y~X)
summary(lm)
## 
## Call:
## lm(formula = Y ~ X)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -495.9  -88.7   22.7  109.2  391.1 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1809.05      55.43   32.64   <2e-16 ***
## X           -1562.32      80.84  -19.33   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 154.3 on 829 degrees of freedom
## Multiple R-squared:  0.3106, Adjusted R-squared:  0.3098 
## F-statistic: 373.5 on 1 and 829 DF,  p-value: < 2.2e-16

Podemos añadir la recta de regresión al gráfico usando el comando abline, y el objeto donde hemos guardado el ajuste de la recta, en este caso lm4:

#representamos
plot(X,Y)
#añadimos la recta de regresion
abline(lm)

Los coeficientes de la regresión estimados también están en el objeto donde hemos guardado el ajuste, en lm

#generamos un vector con los coeficientes de la regresion
coeficientes=lm$coefficients
#comprobamos que es lo mismo que nos salía en el summary
coeficientes
## (Intercept)           X 
##    1809.053   -1562.315

Sabemos que el valor de los puntos cuando X=0, es decir, que el tiempo de reacción sea cero, es de 1809 aproximadamente. Este parámetro no tendría sentido, pues el tiempo de reacción nunca va a ser cero. Por otro lado la pendiente es -1562.315, lo que nos muestra que por cada valor que aumenta X, Y aumenta lo indicado.

Prueba 800m Libre femenino. [Alonso]

Quiero evaluar la prueba 800m libres.

Veamos qué nadadores nadaron el 800 libre femenino:

nadadoras800free<-nadadoresPruebas[nadadoresPruebas$distance==800 & nadadoresPruebas$gender=="F", ]

dim(nadadoras800free)
## [1] 51 21

Se observa que no hay descalificaciones en el 800 libres femenino. Tenemos que 51 chicas nadaron el 800 libres, algunas de ellas dos veces ya que pasaron a la final.

Nos vamos a fijar en la final, para ello, filtramos otra vez los datos:

nadadoras800free<-datos2015[datos2015$gender=="F" & datos2015$distance==800 & datos2015$round=="FIN", ]

Estudio sobre los parciales de la carrera.(ALONSO)

Vamos a evaluar cómo fueron los parciales de las nadadoras, para ello hacemos el siguiente gráfico:

ggplot(nadadoras800free, aes(y=nadadoras800free$lastname, x=nadadoras800free$splitswimtime, fill=nadadoras800free$lastname))+
  geom_boxplot()+
  labs(x="Parciales", y="Nadadoras")

De aquí podemos observar la media y los cuantiles de los parciales de las nadadoras. Observamos que casi todas tienen 1 o incluso 2 puntos atípicos, seguramente se deban al primer y último parcial de la prueba. Además, podemos observar que algunas nadadoras como Kapas y Friis, tuvieron una desviación muy pequeñita en sus parciales, es decir, fueron a un ritmo constante durante toda la prueba clavando sus parciales.

Vamos a observar, para cada nadador, los parciales realizados para ver si podemos conseguir algún patrón de tipo de carrera:

ggplot(nadadoras800free, aes(x=nadadoras800free$splitdistance, y=nadadoras800free$splitswimtime, group = lastname, colour =lastname )) + 
  geom_line()  + 
  geom_point( size=2, shape=21, fill="white") + 
  theme_minimal()+
  labs(x="Parciales", y="Tiempos por parcial.")

Observamos que todas nadan muy rápido tanto el primer parcial como el último. Además, vemos de manera clara como Ledecky parece que alterna un largo un poco más rapido y luego otro más lento durante toda su prueba. ¿Puede ser una estrategia de carrera? Lo veremos más adelante. También vemos alguna otra nadadora más que hace algo similar como Van Rouwendaal. Otras en cambio, intentan conservar el ritmo marcado desde el inicio y ser constantes. Carlin mete un cambio de ritmo muy drástico al paso de los 650m de 31s altos a 31s bajos y sigue luego bajando.

Visualización de la carrera.(alonso)

Ahora, vamos a definir un dataframe en el que nos va a importar el nombre, la suma total de tiempo al paso de cada parcial:

nadadoras800free <- nadadoras800free %>%
  dplyr::select(lastname,firstname,gender,reactiontime,splitdistance,cumswimtime, swimtime)

Visualizamos la carrera:

# Ordenar los datos por tiempo
nadadoras800free <- nadadoras800free %>%
  arrange(splitdistance, cumswimtime)

# Crear un índice de posición
nadadoras800free <- nadadoras800free %>%
  group_by(splitdistance) %>%
  mutate(Posicion = rank(cumswimtime, ties.method = "first"))



ggplot(nadadoras800free, aes(x = splitdistance, y = Posicion, group = lastname)) +
  geom_line(aes(color = lastname, alpha = 1), size = 2) +
  geom_point(aes(color = lastname, alpha = 1), size = 4) +
  scale_y_reverse(breaks = 1:nrow(nadadoras800free))

Observamos como Ledecky lidera toda la carrera, Boyle alcanza al paso de los 100 metros la segunda posición y la mantiene. La pelea por la última medalla en juego dura hasta los 700 metros, donde un adelantamiento de Carlin a Ashwood hace que la nadadora Jaz Carlin alcance el bronce olímpico.

PCA’s

Realizaremos ahora el análisis de componentes principales del 800m libres femenino:

Análisis de componentes principales. 200 mariposa masculino preliminares (Salma)

La idea de realizar el siguiente PCA es porque disponemos de gran cantidad de variables, algunas de las cuales están correlacionadas entre sí, lo que complica su análisis. En estas situaciones es conveniente aplicar el método de componentes principales, que permita reducir el número de variables sin pérdida sustancial de información, y consiguiendo que estas nuevas variables sean incorreladas evitando así que haya información redundante.

Comenzamos,cargando los datos:

prueba200MariposaMasc<- datos2015[datos2015$distance==200 & datos2015$gender=="M" & datos2015$stroke=="FLY"& datos2015$round=="PRE", ]

prueba200MariposaMasc <- prueba200MariposaMasc %>%
    dplyr::select(lastname, reactiontime, splitdistance, splitswimtime, edad)

Creamos un dataframe en la que nos quedamos con el nombre, apellidos y parciales

pruebita <- prueba200MariposaMasc %>%
  pivot_wider(names_from = splitdistance,       # Los valores de 'Split' serán los nombres de las columnas
              values_from =splitswimtime)     # Los valores de 'Tiempo' llenarán las celdas
head(pruebita,10)
## # A tibble: 10 × 7
##    lastname reactiontime  edad  `50` `100` `150` `200`
##    <chr>           <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1 IRVINE           0.71    24  25.9  29.8  30.3  30.9
##  2 MORGAN           0.64    21  25.8  29.3  30.5  30.4
##  3 CROENEN          0.7     21  25.9  29.7  30.1  30.6
##  4 CEPRKALO         0.71    16  27.6  32.0  32.8  33.2
##  5 CASTILLO         0.73    20  29.2  34.3  34.5  37.3
##  6 DE DEUS          0.67    24  25.9  29.4  30.2  30.3
##  7 HAO              0.62    20  26.8  30.2  29.8  32.1
##  8 WANG             0.78    21  25.8  29.4  30.8  32.2
##  9 REALES           0.68    19  26.4  29.6  31.2  33.8
## 10 SEFL             0.74    25  26.3  30.0  30.2  31.1
#omito los valores nulos: 
pruebita<- na.omit(pruebita)
row.names(pruebita) <- pruebita$lastname # esto es para llamar a las filas con el nombre de los nadadores
head(pruebita,10)
## # A tibble: 10 × 7
##    lastname reactiontime  edad  `50` `100` `150` `200`
##    <chr>           <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1 IRVINE           0.71    24  25.9  29.8  30.3  30.9
##  2 MORGAN           0.64    21  25.8  29.3  30.5  30.4
##  3 CROENEN          0.7     21  25.9  29.7  30.1  30.6
##  4 CEPRKALO         0.71    16  27.6  32.0  32.8  33.2
##  5 CASTILLO         0.73    20  29.2  34.3  34.5  37.3
##  6 DE DEUS          0.67    24  25.9  29.4  30.2  30.3
##  7 HAO              0.62    20  26.8  30.2  29.8  32.1
##  8 WANG             0.78    21  25.8  29.4  30.8  32.2
##  9 REALES           0.68    19  26.4  29.6  31.2  33.8
## 10 SEFL             0.74    25  26.3  30.0  30.2  31.1

Calculas estadísticas descriptivas utilizando ‘pastecs::stat.desc’ para entender mejor tus datos:

pastecs::stat.desc(pruebita, basic = F)
##          lastname reactiontime       edad          50         100         150
## median         NA  0.700000000 21.0000000 26.27500000 29.93000000 30.63500000
## mean           NA  0.696250000 22.0750000 26.52475000 30.33925000 31.14000000
## SE.mean        NA  0.008387166  0.5055937  0.15397135  0.23890707  0.28689719
## CI.mean        NA  0.016964644  1.0226598  0.31143646  0.48323516  0.58030435
## var            NA  0.002813782 10.2250000  0.94828712  2.28306353  3.29240000
## std.dev        NA  0.053045095  3.1976554  0.97380035  1.51098098  1.81449718
## coef.var       NA  0.076186850  0.1448542  0.03671289  0.04980285  0.05826902
##                  200
## median   31.62500000
## mean     32.05675000
## SE.mean   0.32686769
## CI.mean   0.66115230
## var       4.27369942
## std.dev   2.06729278
## coef.var  0.06448853

Se puede observar que hay grandes diferencias entre las varianzas de las variables, lo que puede afectar a los resultados de un análisis de componentes principales (ACP), debido a que las variables con mayor varianza tendrán más influencia en la generación de un componente.

El ACP tiene sentido cuando hay correlación entre las variables pues permite eliminar información redundante. Si se analiza la matriz de correlaciones se puede ver, a modo de ejemplo, que hay correlaciones fuertes.Luego, procedemos con el PCA

prueba200MariposaMasc2<- datos2015[datos2015$distance==200 & datos2015$gender=="M" & datos2015$stroke=="FLY"& datos2015$round=="PRE", ]

prueba200MariposaMasc2 <- prueba200MariposaMasc2 %>%
    dplyr::select( reactiontime, splitdistance, splitswimtime, edad)

R <- cor(prueba200MariposaMasc2)
corrplot::corrplot(R, method = "number", 
                   number.cex = 0.75) # Matriz de correlaciones con números en letra pequeña

Para la obtención de los componentes principales utilizamos la función princomp. Para evitar la influencia de la diferencia en magnitud de las varianzas se puede emplear los datos originales y el argumento cor = TRUE o los datos originales estandarizados y el argumento cor = FALSE.Utilizaremos el primer caso,ya que conseguimos que la suma de las varianzas de las variables originales y la de los componentes coincida con el número de variables de la matriz de datos original.

componentess=prcomp(pruebita[,-1], cor = TRUE)
summary(componentess)
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6
## Standard deviation     3.7877 2.4278 0.71817 0.43610 0.27575 0.04753
## Proportion of Variance 0.6824 0.2803 0.02453 0.00905 0.00362 0.00011
## Cumulative Proportion  0.6824 0.9627 0.98723 0.99628 0.99989 1.00000

Los componentes están ordenados en función de la varianza que explican y el porcentaje acumulado permite decidir con cuántos componentes trabajar. En este caso con solo dos se explica el 96%, con tres el 98%, con uno el 68%…

Generalmente, hay un número pequeño de componentes, los primeros, que contienen casi toda la información y el resto suele contribuir relativamente poco. Ya lo hemos visto en nuestro estudio. Podemos directamente coger 2, trabajar sobre el plano y tener una alta varianza explicada, pero vamos a demostrarlo de una manera un poco más empírica. Utilizamos el criterio del autovalor superior a la unidad (regla de Kaiser) y el gráfico de sedimentación (scree test).

Para el primero, tenemos que saber que este criterio retiene aquellos componentes cuyos valores propios son superiores a la unidad y funciona bastante bien salvo con un gran número de variables, que no es nuestro caso.Luego, será muy preciso. Las raices de los autovalores asociados a la matriz de correlaciones son las desviaciones típicas de los componentes y se encuentran en ‘$sdev’ del objeto componentes creado con la función princomp.

auto<-componentess$sdev^2
auto
## [1] 14.34702070  5.89398945  0.51577224  0.19018630  0.07603569  0.00225947

El número de componentes a retener según este criterio sería 2, ya que únicamente hay 2 autovalores mayores que uno. Como ya se ha visto, esta decisión implicaría quedarnos con un 96% de la varianza total de los datos, que es bastante.

Otra manera de ver el número de componentes que escojamos, más gráfica, es un gráfico de sedimentación (scree test). Este gráfico muestra en el eje de ordenadas los autovalores y en el eje de abscisas los componentes. Los cambios en la pendiente nos permiten observar cuánta capacidad explicativa va aportando cada componente.

Se escoge el número de componentes a partir del cual los autovalores restantes son relativamente más pequeños en comparación con él.

plot(componentess, type="lines", main = "Gráfico de sedimentación")
abline(h=1, lty=3, col="red")

El gráfico de codo nos aconseja también quedarnos con 2 componentes. Ambos criterios ofrecen la misma conclusión, que el número de componentes a retener es 2.

Una vez pasamos a la interpretación de las componentes debemos estudiar sus relaciones con cada una de las variables originales. Para ello se obtienen e interpretan las correlaciones entre los componentes (componentes$scores) y las variables. Una forma de calcularla es con la función cor:

Cor_CompVar <- round(cor(pruebita[,-1], componentess$scores), 4) # con round se redondea, en este caso concreto, a 4 decimales 
Cor_CompVar
##              reactiontime    edad      50     100     150     200
## reactiontime       1.0000 -0.0527  0.2612  0.3499  0.3712  0.3496
## edad              -0.0527  1.0000 -0.2486 -0.3753 -0.3986 -0.4533
## 50                 0.2612 -0.2486  1.0000  0.9204  0.8723  0.8215
## 100                0.3499 -0.3753  0.9204  1.0000  0.9516  0.8698
## 150                0.3712 -0.3986  0.8723  0.9516  1.0000  0.8924
## 200                0.3496 -0.4533  0.8215  0.8698  0.8924  1.0000

Estos coeficientes que se acaban de calcular son los que se utilizan para interpretar los componentes. Como se ha decidido retener solo dos componentes, es conveniente crear un objeto que contenga solo las correlaciones con esos tres componentes, que será el objeto a analizar:

Cor_CompVar_retenidos <- Cor_CompVar[, 1:2]
Cor_CompVar_retenidos
##              reactiontime    edad
## reactiontime       1.0000 -0.0527
## edad              -0.0527  1.0000
## 50                 0.2612 -0.2486
## 100                0.3499 -0.3753
## 150                0.3712 -0.3986
## 200                0.3496 -0.4533

Antes de seguir con la interpretación de los componentes, es conveniente analizar si con el número de componentes elegido (dos) están todas las variables bien representadas. Para ello se utiliza el coeficiente de correlación al cuadrado.El valor de la correlación al cuadrado se utiliza para estimar la calidad de la representación. Cuanto más cercano esté a la unidad, mejor será esta.

round(Cor_CompVar[,1:2]^2, 4) # con round se redondea, en este caso concreto, a 4 decimales
##              reactiontime   edad
## reactiontime       1.0000 0.0028
## edad               0.0028 1.0000
## 50                 0.0682 0.0618
## 100                0.1224 0.1409
## 150                0.1378 0.1589
## 200                0.1222 0.2055

Estos resultados se pueden visualizar con corrplot:

corrplot::corrplot(factoextra::get_pca_var(componentess)$cos2[, 1:2], is.corr = F)

La variable correspondiente a 200m se explica principalmente por la componente 1, lo que sugiere que el rendimiento en esta distancia está fuertemente asociado a la variabilidad que captura este componente. La visualización indica que esta relación tiene un porcentaje de varianza explicada de aproximadamente 37% lo cual es significativo.La variable 150m también tiene una correlación notable con el componente 1, aunque en menor medida que la variable de 200m. Esto indica que el rendimiento en 150m también está influenciado por las mismas características que se reflejan en el componente 1.

La variable edad tiene un fuerte impacto en el componente 1, con un porcentaje de varianza explicada alrededor del 74%. Esto sugiere que este componente refleja características que son particularmente relevantes para la edad de los nadadores, implicando que, a medida que los nadadores envejecen, sus tiempos y capacidades en el agua podrían verse influidos por la edad. Este hallazgo es importante porque indica que la edad no solo es un factor en el rendimiento, sino que también está profundamente integrada en los componentes que explican la variabilidad del rendimiento en natación.

factoextra::fviz_cos2(componentess, choice = "var", 
                      axes = 1:2, # axes recoge los componentes a utilizar
                         title = "Cos2 de las variables para los componentes 1 a 2") 

En este caso, se representa la suma de cos2 para los 2 componentes.La proporción de variabilidad explicada por los dos componentes retenidos es bastante baja.

Procedemos, con la función fviz_pca_var del paquete factoextra, donde sobre un círculo de radio unidad, se sitúan las variables, utilizando como coordenadas sus correlaciones con cada uno de los componentes en el plano. Además, las variables se pueden colorear en función de distintas características, entre las que destacan su contribución y el valor del cos2 (por ejemplo, verde, naranja o rojo dependiendo de que sean valores bajos, medios o altos, respectivamente).

En edad,la recta formada por la primera componente solo explica el 0,28% de la varianza de edad, lo que significa que está pobremente representado por esta dimensión.

factoextra::fviz_pca_var(componentess, col.var = "cos2", 
                         gradient.cols = c("green", "orange", "red"),
                         repel = TRUE,
                         title = "Cos2 de las variables en el plano 1")

Cuanto más cercana esté una variable al borde, mejor será la calidad de la representación en el conjunto de las dos componentes.

La variable reactiontime también se observa en una posición cercana al centro del círculo, lo que sugiere que su variabilidad no está suficientemente capturada por los dos componentes principales. Esto refuerza la idea de que el tiempo de reacción podría requerir un análisis más profundo o considerar otros componentes adicionales para una representación más adecuada. Por el contrario, otras variables relacionadas con las distancias (como las variables de 50m, 100m, 150m, y 200m) están más alejadas del centro, lo que indica que están bien representadas por los dos primeros componentes. Esto sugiere que estos componentes capturan la mayor parte de la variabilidad del rendimiento en natación en estas distancias. Este PCA, dadas las conclusiones que hemos obtenido, y las variables que hay, simplemente se utilizará para entender la manera de proceder

Análisis de componentes principales del 800 libres femenino. Ronda preliminar [Alonso]

Lo primero que debemos hacer es cargar los datos:

prueba800libresPreliminar<- datos2015[datos2015$distance==800 & datos2015$gender=="F" & datos2015$stroke=="FREE" & datos2015$round=="PRE", ]

prueba800libresPreliminar <- prueba800libresPreliminar %>%
    dplyr::select(lastname, reactiontime, splitdistance, splitswimtime, edad)

Bien, ahora, debemos encontrar la manera de crear un dataframe en la que nos quedemos con el nombre, apellido y parciales.

pruebawide <- prueba800libresPreliminar %>%
  pivot_wider(names_from = splitdistance,       # Los valores de 'Split' serán los nombres de las columnas
              values_from =splitswimtime)     # Los valores de 'Tiempo' llenarán las celdas
#omito los valores nulos: 
pruebawide<- na.omit(pruebawide)
pruebawide<- as.data.frame(pruebawide)
rownames(pruebawide) <- pruebawide$lastname

Ahora que ya tenemos nuestro dataframe hecho, vamos a hacer el PCA:

pca800libres<-prcomp(pruebawide[,-1], scale=T)

plot(pca800libres)

Vemos la importancia de cadad componente.

Observemos además, un resumen numérico:

summary(pca800libres)
## Importance of components:
##                           PC1     PC2     PC3     PC4     PC5    PC6     PC7
## Standard deviation     3.8975 1.04130 0.77791 0.73825 0.50625 0.3176 0.26117
## Proportion of Variance 0.8439 0.06024 0.03362 0.03028 0.01424 0.0056 0.00379
## Cumulative Proportion  0.8439 0.90415 0.93777 0.96804 0.98228 0.9879 0.99167
##                           PC8     PC9    PC10    PC11    PC12    PC13    PC14
## Standard deviation     0.2165 0.16872 0.15816 0.10756 0.09255 0.08565 0.08227
## Proportion of Variance 0.0026 0.00158 0.00139 0.00064 0.00048 0.00041 0.00038
## Cumulative Proportion  0.9943 0.99586 0.99725 0.99789 0.99837 0.99878 0.99915
##                           PC15    PC16    PC17    PC18
## Standard deviation     0.07436 0.06568 0.05874 0.04421
## Proportion of Variance 0.00031 0.00024 0.00019 0.00011
## Cumulative Proportion  0.99946 0.99970 0.99989 1.00000

Viendo el pca, observamos que con la primera componente, tenemos un 84% de la varianza. Con pc2 un 6%, luego con esas dos logramos explicar un 90% de los datos.

Hagamos una interpretación previa a la graficación de los datos:

pca800libres
## Standard deviations (1, .., p=18):
##  [1] 3.89747634 1.04130246 0.77791355 0.73825364 0.50625249 0.31756324
##  [7] 0.26117066 0.21651865 0.16872466 0.15815858 0.10756232 0.09255060
## [13] 0.08565274 0.08227018 0.07435885 0.06567886 0.05874500 0.04421473
## 
## Rotation (n x k) = (18 x 18):
##                      PC1           PC2          PC3         PC4         PC5
## reactiontime  0.06193838 -0.8548167721  0.390560844  0.32124873 -0.03857645
## edad         -0.14922291 -0.4272042870 -0.865816941 -0.01292133  0.19527371
## 50            0.21873835 -0.1852520188 -0.047501605 -0.54013522 -0.43636572
## 100           0.24304415 -0.0906112177  0.013301059 -0.32452317 -0.11528177
## 150           0.24266268 -0.1221686581  0.040018216 -0.30576570 -0.01078452
## 200           0.25220373 -0.0435807848 -0.047430110 -0.18342797  0.05149037
## 250           0.25150962 -0.0450643808  0.004591957 -0.16016883  0.14254777
## 300           0.25229932 -0.0067871667 -0.028203926 -0.09798486  0.20200703
## 350           0.25296586 -0.0004885932  0.020263880 -0.05651860  0.19651276
## 400           0.25196991  0.0334488708 -0.027688537  0.05836570  0.29761134
## 450           0.25299286  0.0034375483  0.043000131  0.07311231  0.17494057
## 500           0.25081998  0.0701810721 -0.031170966  0.13333844  0.24407095
## 550           0.25212116  0.0375039940 -0.014162824  0.12523639  0.12781623
## 600           0.25000543  0.0450093858 -0.038173636  0.22535753  0.12195496
## 650           0.25256582  0.0448853314 -0.076272431  0.13890475 -0.03990197
## 700           0.24968187  0.0691198608 -0.104780045  0.18520717 -0.07621293
## 750           0.24437594  0.0399792675 -0.111081401  0.22839212 -0.29485371
## 800           0.22640840  0.0864609770 -0.236497695  0.36772621 -0.59149551
##                      PC6          PC7         PC8           PC9        PC10
## reactiontime -0.06320574  0.008203497  0.02726631  0.0016185780  0.01370549
## edad          0.04964498 -0.009105225 -0.03714785 -0.0082632806  0.01628572
## 50           -0.08375111 -0.602918823  0.11240484  0.0542184748 -0.13440568
## 100          -0.27416392  0.265411609 -0.55989027 -0.1782520178  0.41164562
## 150           0.39935215  0.388060284 -0.11927503 -0.1056307933 -0.59617578
## 200          -0.08390374  0.276365292  0.01259943 -0.0005069006  0.26374932
## 250           0.04664399  0.252087677  0.41634683  0.1902374007 -0.04928838
## 300          -0.27339011  0.138770334  0.30649506  0.1543689706 -0.02806555
## 350           0.17510060 -0.118950996  0.34691102  0.0282411937  0.34151686
## 400          -0.18722770 -0.060831923  0.05658450 -0.1756724764 -0.02973623
## 450           0.26225099 -0.188223904 -0.02619956 -0.1103499027  0.22110002
## 500          -0.18298716 -0.101041765 -0.19416846 -0.1581060911 -0.32803989
## 550           0.26197282 -0.209128801 -0.06367207 -0.4632181799  0.04398533
## 600          -0.16546973 -0.204751880 -0.28642501  0.2149860944 -0.26590464
## 650           0.18993957 -0.216064262 -0.08310223  0.0711705367  0.09466852
## 700          -0.34901294  0.006561143 -0.05714779  0.4184610780 -0.06587642
## 750           0.46518630  0.125722857 -0.18850594  0.4519068155  0.14565214
## 800          -0.17219420  0.210814206  0.31041715 -0.4242872746 -0.05151590
##                     PC11         PC12        PC13          PC14         PC15
## reactiontime -0.01715754  0.007403521 -0.04781775  0.0003629539  0.014172328
## edad          0.02895397 -0.015254631  0.03597715  0.0004642981  0.022243228
## 50            0.02351097 -0.072919101 -0.08351676  0.0497113278 -0.075898232
## 100           0.03217521 -0.146706765  0.10841263 -0.0596309691  0.180177855
## 150           0.17945969  0.243556077  0.07890695 -0.1410937705 -0.021532486
## 200          -0.23718291  0.303864871 -0.17373727  0.2325400789 -0.344047304
## 250          -0.25772493 -0.441349209  0.14724654 -0.1040860071  0.302186304
## 300          -0.19394884  0.001338898  0.11166814  0.1908268163 -0.117339073
## 350           0.35488871  0.153357570 -0.06804674  0.1237397843  0.050910678
## 400           0.16918088  0.084590245 -0.43011911 -0.4289384277 -0.352980823
## 450           0.38098933  0.101320928  0.49754216  0.1400142978  0.060992412
## 500           0.11518150 -0.125336221 -0.38831205  0.5231318547  0.416038434
## 550          -0.26467781 -0.456132587  0.02316746 -0.2590607944 -0.135097732
## 600          -0.20827190  0.025718113  0.43396492  0.1656587623 -0.388602299
## 650          -0.50744753  0.528670979 -0.07726505 -0.2182791732  0.440655874
## 700           0.33770410 -0.021833979  0.06374683 -0.4524806234  0.182179444
## 750           0.05585311 -0.274575286 -0.32716717  0.1562877385 -0.190987570
## 800           0.06077417  0.075493364  0.11500893  0.0938356703 -0.007798138
##                      PC16         PC17        PC18
## reactiontime  0.007947949  0.010391723 -0.01487313
## edad          0.004990501  0.005052875  0.01092969
## 50           -0.063934437 -0.045743920 -0.04467770
## 100          -0.011465511  0.091875649  0.27335132
## 150           0.095699678  0.112721548  0.01044089
## 200           0.167283160 -0.340216451 -0.49785382
## 250          -0.078423562 -0.446172358  0.14410293
## 300          -0.272697460  0.704220476 -0.04447674
## 350           0.556409962  0.114013418  0.34147945
## 400          -0.366526613 -0.168685837  0.27710032
## 450          -0.473182256 -0.146309882 -0.24623668
## 500           0.011017785 -0.067437200 -0.09302387
## 550           0.265557775  0.220359319 -0.29460319
## 600           0.219600306 -0.181298248  0.32890114
## 650          -0.089361203  0.053484304  0.09034484
## 700           0.226211294  0.046041586 -0.40917018
## 750          -0.178753583  0.098606686  0.07707289
## 800          -0.014997495 -0.048414027  0.11429181

La PCA1 corresponde a una media ponderada en la cual, lo que más ponderan son los parciales de la prueba, siendo los más significativos del 200 al 650. También toma algo de importancia la edad pero no se verá reflejada. Luego, nos esperaremos más a la izquierda los nadadores cuyo tiempo medio sea menor (es decir, las más rapidas de las preliminares), y a la derecha las nadadoras más lentas en promedio.

La PCA2, cobra muchísima importancia el tiempo de reacción y la edad. Luego, esperaremos, contra más arriba se encuentren, nadadoras con un buen tiempo de reacción o pocos años, y abajo nadadoras con mal tiempo de reacción o muchos años.

Ahora, veamos cómo se ven los datos:

plot(pca800libres$x[,1:2], type="n")
text(pca800libres$x[,1:2],rownames(pruebawide), cex = 0.4)

Luego, podríamos decir que, el grupo de Ledecky, Carlin… fueron las más rapidas de las preliminares. Chentson, Holowchak y Rannvaardottir las más lentas.

También, podríamos decir que, nadadoras como Jo, corresponden a un tiempo de reacción muy bajo junto con una edad baja. Nadadoras como Kobrich y Elhenicka, serán nadadoras con más años y que además tienen un mal tiempo de reacción en comparación con todas las demás.

Veámos la ponderación de las variables con el siguiente gráfico:

fviz_pca_var(pca800libres, col.var = "red")

Viendo esta interpretación, podemos observar de una mejor manera, cuando un nadador va a estar más “arriba” o “abajo”, si es causa de la edad o del tiempo de reacción. Luego, si nos fijamos en las nadadoras del gráfico anterior, podremos asegurar que, Gill, tiene un tiempo de reacción pésimo, ledecky es rápida y joven y buen tiempo de reacción. Hassler es una nadadora con más edad pero de las más rapidas pero con mal tiempo de reacción.

#biplot(pca800libres)

fviz_pca_biplot(pca800libres, repel = TRUE)

Análisis de componentes principales del 100m mariposa femenino. [JAVIER]

En primer lugar, vamos a crear un nuevo dataframe llamado prueba100MariposaFem en la cuál nos quedamos con todas las pruebas de atletas femeninos, de distancia igual a 100 metros y de estilo de nado mariposa. A continuación, nos quedamos con las columnas de lastname, reactiontime, splitdistance, splitswimtime y swimtime del dataframe prueba100MariposaFem.

# Filtro de pruebas de 100m mariposa femenino
prueba100MariposaFem <- datos2015[datos2015$distance==100 & datos2015$gender=="F" & datos2015$stroke=="FLY" & datos2015$round =="PRE",]

# Selección de columnas relevantes
prueba100MariposaFem <- prueba100MariposaFem %>% dplyr::select(lastname, reactiontime, splitdistance, splitswimtime)
head(prueba100MariposaFem, 10)
##      lastname reactiontime splitdistance splitswimtime
## 1      BORSHI         0.77            50         29.63
## 2      BORSHI         0.77           100         34.02
## 84    NOBREGA         0.75            50         30.35
## 85    NOBREGA         0.75           100         35.49
## 322    MCKEON         0.77            50         27.21
## 323    MCKEON         0.77           100         30.91
## 543    GROVES         0.75            50         27.41
## 544    GROVES         0.75           100         30.90
## 873 BAYRAMOVA         0.77            50         31.53
## 874 BAYRAMOVA         0.77           100         35.26

A continuación, vamos a organizar los datos del dataframe prueba100MariposaFem. de modo que cada nadador tiene una fila única con columnas para cada distancia.

prueba <- prueba100MariposaFem %>%
  pivot_wider(names_from = splitdistance,       # Las diferenetes distancias se convierten en los nombres de las columnas
              values_from =splitswimtime)     #los valores de las celdas serán los tiempos de nado

#Eliminamos duplicados y NA de la columna 'lastname'
prueba <- prueba[!duplicated(prueba$lastname) & !is.na(prueba$lastname), ]

#Convertimos a data frame
prueba <- as.data.frame(prueba)

# Asignar los nombres de fila como el apellido del nadador
row.names(prueba) <- prueba$lastname

#Eliminamos filas con NA restantes
prueba <- na.omit(prueba)
head(prueba,10)
##            lastname reactiontime    50   100
## BORSHI       BORSHI         0.77 29.63 34.02
## NOBREGA     NOBREGA         0.75 30.35 35.49
## MCKEON       MCKEON         0.77 27.21 30.91
## GROVES       GROVES         0.75 27.41 30.90
## BAYRAMOVA BAYRAMOVA         0.77 31.53 35.26
## BUYS           BUYS         0.75 26.95 31.41
## KAJTAZ       KAJTAZ         0.74 28.32 35.07
## RIBERA       RIBERA         0.74 30.18 36.91
## DE PAULA   DE PAULA         0.65 27.50 31.09
## DIAS           DIAS         0.68 27.39 32.36

Con todo esto, estamos preparados para realizar el PCA.

#Realizamos el PCA (estandarizamos los datos)
pca_100mariposafemenino <- prcomp(prueba[,-1], scale=T)
pca_100mariposafemenino
## Standard deviations (1, .., p=3):
## [1] 1.4922411 0.8357174 0.2734828
## 
## Rotation (n x k) = (3 x 3):
##                     PC1        PC2         PC3
## reactiontime -0.4453148 -0.8940251  0.04913078
## 50           -0.6383197  0.2785111 -0.71762072
## 100          -0.6278875  0.3509282  0.69469898

Observamos que la primera y segunda componente son las que tienen mayor valor de standard deviations, luego serán las más relevantes a efectos de la visualización. Veamos la importancia relativa de cada componente

plot(pca_100mariposafemenino)

summary(pca_100mariposafemenino)
## Importance of components:
##                           PC1    PC2     PC3
## Standard deviation     1.4922 0.8357 0.27348
## Proportion of Variance 0.7423 0.2328 0.02493
## Cumulative Proportion  0.7423 0.9751 1.00000

El resultado del análisis de componentes principales (PCA) muestra tres componentes principales (PC1, PC2, PC3). Veamos cada aspecto de la salida: Los datos de la fila de desivación estándar (Standard deviation), cuanto mayores sean, mas variabilidad de los datos se captura. En este caso, la componente principal PC1 es la que tiene mayor desviación estándar, lo que sugiere que capta la mayor parte de la varianza.

En segundo lugar, la proporción de la varianza (proportion of variance) indica qué porcentaje de la varianza total de los datos está capturado por cada componente. Aquí, PC1 captura el 74.23% de la varianza, mientras que PC2 captura el 23.28%, y PC3 solo el 2.493%. Esto significa que PC1 es el componente más relevante para representar la estructura de los datos, mientras que PC3 aporta muy poco. (como habiámos adelantado anteriormente)

Por último, para la variable de proporción acumulada (cumulative proportion) indica la varianza total capturada al considera las componentes en conjunto. PC1 junto con PC2 explican el 97,51% de la variabilidad de los datos (bastante alto). Esto sugiere que podemos reducir la dimensionalidad a estas dos primeros componentes sin perder mucha información.

El análisis PCA muestra que los datos prueba pueden ser bien representados con solo dos componentes principales (PC1 y PC2). Este resultado implica que la mayor parte de la variabilidad de los tiempos de nado de los participantes se puede resumir en estas dos dimensiones.

Por último, dibujamos los datos proyectados sobre las dos primeras componentes

plot(pca_100mariposafemenino$x[,1:2])
text(pca_100mariposafemenino$x[,1:2], rownames(prueba[,-1]))

biplot(pca_100mariposafemenino) 

Análisis de componentes principales en la carrera preliminar de 1500 metros (INES)

Vamos a ver en qué estilo predominan los nadadores de 1500 metros.

summary(nadadoresPruebas$stroke[nadadoresPruebas$distance == 1500])
##   BACK BREAST    FLY   FREE MEDLEY 
##      0      0      0     85      0
summary(nadadoresPruebas$round[nadadoresPruebas$distance == 1500])
## FIN PRE SEM SOP SOS 
##  15  70   0   0   0

Como podemos observar, todos los nadadores nadan en estilo libre. Por tanto, no seleccionaremos según esa imposición, ya que nos viene de los propios datos. Gracias a ello, tenemos un enfoque más global de la carrera de 1500 metros.

Además, tenemos 70 participantes en rondas preliminares y 15 finales. Por tanto, tomaremos la ronda preliminar para hacer nuestro análisis de componentes principales.

# Filtro de pruebas de 1500m masculino
datos1500Masc <- datos2015[datos2015$distance==1500 & datos2015$gender=="M" & datos2015$round =="PRE",]

# Selección de columnas relevantes
datos1500Masc <- datos1500Masc %>% dplyr::select(lastname, reactiontime, splitdistance, splitswimtime)
head(datos1500Masc,15)
##         lastname reactiontime splitdistance splitswimtime
## 46 ARIAS DOURDET         0.72            50         29.03
## 47 ARIAS DOURDET         0.72           100         31.41
## 48 ARIAS DOURDET         0.72           150         31.87
## 49 ARIAS DOURDET         0.72           200         31.73
## 50 ARIAS DOURDET         0.72           250         32.03
## 51 ARIAS DOURDET         0.72           300         32.30
## 52 ARIAS DOURDET         0.72           350         32.49
## 53 ARIAS DOURDET         0.72           400         32.63
## 54 ARIAS DOURDET         0.72           450         32.68
## 55 ARIAS DOURDET         0.72           500         33.14
## 56 ARIAS DOURDET         0.72           550         32.59
## 57 ARIAS DOURDET         0.72           600         32.86
## 58 ARIAS DOURDET         0.72           650         33.05
## 59 ARIAS DOURDET         0.72           700         32.99
## 60 ARIAS DOURDET         0.72           750         33.04
prueba1500 <- datos1500Masc %>%
  pivot_wider(names_from = splitdistance,       # Los valores de 'Split' serán los nombres de las columnas
              values_from =splitswimtime)     # Los valores de 'Tiempo' llenarán las celdas

#Eliminamos duplicados y NA de la columna 'lastname'
prueba1500 <- prueba1500[!duplicated(prueba1500$lastname) & !is.na(prueba1500$lastname), ]

prueba1500 <- as.data.frame(prueba1500)

# Asignar los nombres de fila como el apellido del nadador
row.names(prueba1500) <- prueba1500$lastname

#Eliminamos filas con NA restantes
prueba1500 <- na.omit(prueba1500)
head(prueba1500,15)
##                          lastname reactiontime    50   100   150   200   250
## ARIAS DOURDET       ARIAS DOURDET         0.72 29.03 31.41 31.87 31.73 32.03
## NAIDICH                   NAIDICH         0.71 28.27 30.66 30.51 30.70 30.47
## HORTON                     HORTON         0.73 27.26 29.59 29.78 30.00 29.88
## AUBOCK                     AUBOCK         0.75 27.38 29.70 30.17 30.59 30.73
## CEPRKALO                 CEPRKALO         0.73 28.00 30.52 30.78 31.14 31.13
## COCHRANE                 COCHRANE         0.71 27.42 29.33 29.82 29.94 29.90
## BUTLER                     BUTLER         0.73 28.84 30.96 32.12 32.32 32.66
## TAPIA SALINAS       TAPIA SALINAS         0.74 29.38 31.10 31.50 31.58 31.44
## SUN                           SUN         0.75 27.34 29.64 29.75 29.49 29.90
## WANG                         WANG         0.74 28.11 30.16 30.40 30.48 30.43
## SAEMUNDSSON           SAEMUNDSSON         0.67 27.82 30.28 30.88 31.23 30.99
## MICKA                       MICKA         0.70 28.08 30.14 29.49 30.11 29.86
## ENDERICA SALGADO ENDERICA SALGADO         0.68 28.05 30.70 30.46 30.70 30.56
## AHMED                       AHMED         0.71 27.37 29.96 29.84 30.01 29.92
## ACOSTA                     ACOSTA         0.76 27.66 29.90 30.55 30.49 30.47
##                    300   350   400   450   500   550   600   650   700   750
## ARIAS DOURDET    32.30 32.49 32.63 32.68 33.14 32.59 32.86 33.05 32.99 33.04
## NAIDICH          30.63 30.71 30.65 30.17 30.40 30.27 30.33 30.34 30.42 30.59
## HORTON           30.10 30.07 29.96 30.34 30.13 30.13 29.92 30.22 30.11 30.32
## AUBOCK           30.68 31.01 30.80 31.24 31.14 31.58 31.41 31.78 31.62 32.18
## CEPRKALO         31.09 31.26 31.03 31.16 31.11 31.27 30.94 31.06 30.95 30.93
## COCHRANE         29.91 29.90 29.94 30.32 30.14 29.64 29.89 29.90 29.74 29.89
## BUTLER           32.43 32.81 32.81 32.76 32.64 33.12 32.86 32.97 32.71 33.19
## TAPIA SALINAS    31.51 31.55 31.65 31.46 31.41 31.73 31.78 31.93 31.93 32.02
## SUN              29.93 29.64 29.90 29.88 30.02 29.83 30.14 29.60 29.98 29.32
## WANG             30.48 30.39 30.49 30.34 30.64 30.62 30.78 30.43 30.89 30.62
## SAEMUNDSSON      31.59 31.40 31.72 31.95 31.93 31.83 32.12 31.99 32.05 32.05
## MICKA            29.89 30.33 30.04 30.12 30.37 30.48 30.28 30.38 30.59 31.07
## ENDERICA SALGADO 30.60 30.68 30.69 30.85 30.68 30.76 30.54 30.72 30.92 31.03
## AHMED            29.98 29.99 30.06 29.93 29.98 29.96 29.91 29.99 29.87 29.86
## ACOSTA           30.58 30.66 30.78 30.50 30.81 30.48 30.94 31.03 30.54 30.43
##                    800   850   900   950  1000  1050  1100  1150  1200  1250
## ARIAS DOURDET    33.15 33.15 33.43 33.38 33.37 33.42 33.59 33.80 33.77 33.92
## NAIDICH          30.53 30.52 30.41 30.55 30.62 30.75 30.88 31.10 30.96 30.80
## HORTON           29.71 30.29 30.29 30.39 30.16 30.34 30.13 30.44 30.46 30.46
## AUBOCK           31.75 32.40 32.19 32.35 32.30 32.59 32.49 32.49 32.23 32.71
## CEPRKALO         30.89 30.90 30.97 31.00 30.97 31.37 30.99 31.19 31.05 31.22
## COCHRANE         30.11 29.96 30.03 30.19 29.96 30.09 30.42 30.15 30.16 30.13
## BUTLER           33.01 33.14 33.23 32.98 33.19 33.29 33.22 33.30 32.97 33.36
## TAPIA SALINAS    31.80 31.97 31.86 31.72 31.82 32.16 31.88 31.95 31.63 31.83
## SUN              29.97 29.72 29.69 29.65 29.97 29.69 29.90 29.99 30.35 30.27
## WANG             30.91 30.60 30.93 30.49 31.12 30.54 31.11 30.56 30.97 31.02
## SAEMUNDSSON      32.28 32.33 32.13 32.36 32.31 31.82 32.69 32.52 32.49 32.38
## MICKA            30.63 31.21 30.95 31.53 30.79 31.88 31.11 31.96 31.29 32.22
## ENDERICA SALGADO 30.70 30.99 30.78 31.05 30.94 30.99 31.00 31.13 30.81 30.95
## AHMED            29.90 30.04 30.01 29.99 29.91 30.05 29.91 30.10 29.94 30.05
## ACOSTA           30.86 30.78 30.82 30.99 30.93 30.66 31.38 31.71 31.95 32.08
##                   1300  1350  1400  1450  1500
## ARIAS DOURDET    33.44 34.00 33.80 33.58 32.71
## NAIDICH          30.89 31.00 31.06 30.55 28.64
## HORTON           30.29 30.43 30.45 30.33 28.53
## AUBOCK           32.39 32.40 32.27 32.53 30.59
## CEPRKALO         31.01 31.19 30.95 30.87 29.28
## COCHRANE         30.28 30.00 30.07 30.04 28.69
## BUTLER           33.15 33.32 33.16 32.93 31.73
## TAPIA SALINAS    31.97 31.51 31.54 31.05 28.97
## SUN              30.51 30.79 30.90 29.68 29.67
## WANG             30.98 30.82 30.74 30.49 30.15
## SAEMUNDSSON      32.50 32.40 32.54 31.89 30.96
## MICKA            31.28 31.84 31.48 32.22 30.54
## ENDERICA SALGADO 30.73 30.80 30.96 31.02 29.79
## AHMED            30.08 30.24 30.02 29.98 28.57
## ACOSTA           31.55 32.05 32.37 30.84 30.35

Con todo esto, estamos preparados para realizar el PCA:

#Realizamos el PCA
pca_1500masculino <- prcomp(prueba1500[,-1], scale=T)

# Resultados del PCA
summary(pca_1500masculino)
## Importance of components:
##                           PC1     PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     5.0272 1.54955 1.03674 0.72833 0.63261 0.55460 0.47030
## Proportion of Variance 0.8152 0.07746 0.03467 0.01711 0.01291 0.00992 0.00713
## Cumulative Proportion  0.8152 0.89269 0.92737 0.94448 0.95739 0.96731 0.97444
##                            PC8     PC9    PC10    PC11    PC12    PC13    PC14
## Standard deviation     0.39148 0.36026 0.28540 0.25473 0.24485 0.22520 0.19551
## Proportion of Variance 0.00494 0.00419 0.00263 0.00209 0.00193 0.00164 0.00123
## Cumulative Proportion  0.97939 0.98357 0.98620 0.98830 0.99023 0.99186 0.99310
##                           PC15   PC16    PC17    PC18    PC19    PC20    PC21
## Standard deviation     0.18981 0.1667 0.15800 0.14214 0.13401 0.13079 0.11684
## Proportion of Variance 0.00116 0.0009 0.00081 0.00065 0.00058 0.00055 0.00044
## Cumulative Proportion  0.99426 0.9952 0.99596 0.99661 0.99719 0.99774 0.99819
##                           PC22    PC23    PC24    PC25    PC26    PC27    PC28
## Standard deviation     0.10610 0.10258 0.08803 0.08170 0.07142 0.06929 0.05867
## Proportion of Variance 0.00036 0.00034 0.00025 0.00022 0.00016 0.00015 0.00011
## Cumulative Proportion  0.99855 0.99889 0.99914 0.99935 0.99952 0.99967 0.99978
##                           PC29    PC30    PC31
## Standard deviation     0.05400 0.04872 0.03778
## Proportion of Variance 0.00009 0.00008 0.00005
## Cumulative Proportion  0.99988 0.99995 1.00000

Por tanto, vemos el Análisis de Componentes Principales (PCA) en los datos de nadadores masculinos en la carrera de 1500 metros, excluyendo la primera variable, que es el nombre.

Observamos que el primer componente principal (PC1) tiene una desviación estándar de 5.0272 y explica el 81.52% de la varianza total. Este componente captura la mayor parte de la variabilidad en los datos, lo que sugiere que una sola dirección en el espacio de los datos contiene gran parte de la información relevante. Los siguientes componentes, como PC2 y PC3, explican 7.75% y 3.47% de la varianza respectivamente. Estos valores disminuyen progresivamente, lo que indica que los componentes adicionales explican cada vez menos de la variabilidad total. Así pues, los primeros dos componentes principales explican el 89,27% de la varianza. Si añadimos el tercer componente, logran explicar el 92.73% de la varianza, lo que puede ser suficiente para una interpretación efectiva de los datos.

Visualizamos ahora cómo se distribuyen los datos en las dos primeras componentes principales y observamos la influencia de las variables en estas componentes.

fviz_pca_biplot(pca_1500masculino, repel = TRUE)

Viendo el gráfico, podemos interpretar la primera componente como la rapidez en cada split de los participantes. Cuantos mayores tiempos tienen en cada split, mas desplazados estarán hacia la izquierda. Por tanto, los nadadores mas a la derecha serán aquellos con mejores resultados. Vemos como el 81,5% de la varianza de los resultados está explicado por estos tiempos, como podría imaginarse en un principio. Si nos enfocamos en lo que explica la componente 2, vemos que mayores tiempos de los primeros splits condicionan su desplazamiento hacia abajo, y los tiempos mayores en los ultimos splits desplazan los puntos hacia arriba. Esto parece indicar que la componente 2 captura las diferencias entre el rendimiento en las etapas iniciales y finales de la prueba, posiblemente destacando la resistencia o la fatiga en los nadadores. Además, es claramente visible como el tiempo del último split (cuando se completan los 1500m) es muy influyente en la posición de estos nadadores. Es decir, los tiempos en esta última parte parecen ser muy decisivos en cuanto a su resultado final.

Si observamos la influencia del tiempo de reacción, los tiempos de reacción altos ejercen influencia a favor del eje x e y, en sus sentidos positivos. Con lo cual, el tiempo de reacción alto parece estar asociado con un rendimiento positivo en los splits y posiblemente en la resistencia hacia el final de la prueba.

Para ver si estas cuestiones se cumplen, vamos a observar si los primeros puestos del ranking de puntos de esta categoría coincide con lo visto en el gráfico.

# Filtro de pruebas de 1500m masculino
resumen1500 <- datos2015[datos2015$distance==1500 & datos2015$gender=="M" & datos2015$round =="PRE",]

# Selección de columnas relevantes
resumen1500 <- resumen1500 %>% dplyr::select(lastname,points) %>%
    distinct() %>%         
    arrange(desc(points))


resumen1500
##            lastname points
## 1       PALTRINIERI    934
## 2            JAEGER    926
## 3               SUN    921
## 4             MILNE    921
## 5             AHMED    920
## 6          COCHRANE    918
## 7           MCBROOM    915
## 8         ROMANCHUK    913
## 9           JOENSEN    910
## 10             JOLY    910
## 11           HORTON    904
## 12     CHRISTIANSEN    899
## 13             NAGY    894
## 14           STRAUB    892
## 15      BRZOSKOWSKI    874
## 16          SANCHEZ    868
## 17          NAIDICH    864
## 18           WOJDAK    864
## 19             WANG    857
## 20           GYURTA    857
## 21             CAPP    854
## 22 ENDERICA SALGADO    847
## 23            MICKA    842
## 24              BAU    840
## 25           ACOSTA    834
## 26         CEPRKALO    831
## 27         MAKSUMOV    830
## 28           FROLOV    822
## 29         MEISSNER    821
## 30         WEERTMAN    816
## 31            KARAP    814
## 32            GOMEZ    814
## 33            CELIC    811
## 34              CHO    802
## 35          PRAKASH    782
## 36           AUBOCK    781
## 37    TAPIA SALINAS    781
## 38      BAYO PUNTER    780
## 39      SAEMUNDSSON    762
## 40           SANCOV    761
## 41              LAM    759
## 42          VENTURA    756
## 43    SIM WEE SHENG    724
## 44           BUTLER    699
## 45    ARIAS DOURDET    688

Como podemos comprobar, Paltrinieri, Jaeger, Sun y Milne aparecen en los puntos más extremos del eje x. Además, se localizan en la posición central, lo que parece indicar que sus tiempos son bastante estables durante todo el recorrido. Si visualizamos los últimos nadadores, que son Arias Dourdet, Butler y Sim Wee Sheng, observamos que efectivamente están en los extremos izquierdos del eje x. Además, Arias Dourdet y Butler están desplazados hacia el eje y, lo que parece indicar que obtuvieron tiempos más largos en sus splits finales, posiblemente debido a una falta de resistencia y mayor fatiga en estos tiempos, que es un factor crucial para el desarrollo de este tipo de pruebas.

Clusters

Cluster sobre el 800m libres femenino. Análisis de estrategias de las nadadoras. [Alonso]

Voy a crear a continuación un dataframe en el cual, contenga el nombre de las nadadoras del 800 libres femenino. Además, quiero los parciales al paso por cada 50 y el tiempo final.

Vamos a intentar, normalizar de cierta manera los parciales respecto del tiempo final, para intentar ver estrategias de carrera en las nadadoras. Obsérvese que, normalizamos los datos porque pueden existir dos nadadoras cuya estrategia de carrera sea la misma, pero que se encuentren muy alejadas en el cluster debido a que sus tiempos son lo suficientemente distintos. Es por ello que normalizaremos los datos.

Empecemos creando los dataframes de manera análoga a como lo hicimos en el PCA:

prueba800libresPreliminar<- datos2015[datos2015$distance==800 & datos2015$gender=="F" & datos2015$stroke=="FREE" & datos2015$round=="PRE", ]

prueba800libresPreliminar <- prueba800libresPreliminar %>%
    dplyr::select(lastname, splitdistance, splitswimtime,swimtime)

free800WomensPre <- prueba800libresPreliminar %>%
  pivot_wider(names_from = splitdistance,       # Los valores de 'Split' serán los nombres de las columnas
              values_from =splitswimtime)     # Los valores de 'Tiempo' llenarán las celdas
#omito los valores nulos: 
free800WomensPre<- na.omit(free800WomensPre)

free800WomensPre <- as.data.frame(free800WomensPre)

rownames(free800WomensPre) <- free800WomensPre$lastname

A continuación, vamos a echar un vistazo a lo creado:

head(free800WomensPre, 10)
##                  lastname swimtime    50   100   150   200   250   300   350
## HOLOWCHAK       HOLOWCHAK   577.68 32.43 35.90 35.04 36.39 35.92 36.23 36.67
## VAN DEN BERG VAN DEN BERG   543.71 31.59 33.90 34.14 34.22 33.67 33.88 34.15
## ASHWOOD           ASHWOOD   502.17 29.25 31.42 31.80 31.91 31.95 32.04 31.95
## NEALE               NEALE   524.38 29.50 32.48 33.16 32.90 32.68 32.84 33.55
## EVANS               EVANS   529.96 30.00 32.32 32.97 32.83 32.99 32.94 33.19
## GILL                 GILL   556.23 31.15 34.54 34.60 34.57 34.62 34.96 35.10
## KOBRICH           KOBRICH   513.12 30.33 31.92 32.18 32.17 32.15 32.16 32.31
## ZHANG               ZHANG   515.17 29.63 31.83 32.40 32.14 32.46 32.43 32.58
## CAO                   CAO   523.24 29.61 32.63 32.67 32.54 32.48 32.42 32.55
## TE FLAN           TE FLAN   556.89 30.41 34.33 33.76 34.95 34.76 35.45 34.99
##                400   450   500   550   600   650   700   750   800
## HOLOWCHAK    36.76 36.48 36.85 36.92 36.68 36.97 36.98 36.17 35.29
## VAN DEN BERG 33.91 34.41 33.92 34.36 34.38 34.60 34.45 34.72 33.41
## ASHWOOD      31.65 31.57 31.39 31.61 31.43 31.46 31.47 31.34 29.93
## NEALE        33.74 33.71 33.60 33.71 33.12 33.14 32.79 32.73 30.73
## EVANS        33.60 33.72 33.74 33.82 33.67 33.86 33.59 34.24 32.48
## GILL         35.22 35.63 35.56 35.43 35.67 35.26 35.42 35.03 33.47
## KOBRICH      32.27 32.32 32.23 32.42 32.34 32.32 32.27 32.23 31.50
## ZHANG        32.46 32.60 32.42 32.79 32.33 32.47 32.63 32.47 31.53
## CAO          32.45 32.94 33.03 33.12 33.47 33.42 33.48 34.07 32.36
## TE FLAN      36.11 35.27 35.82 35.48 36.12 35.20 36.07 34.56 33.61

Ahora, voy a normalizar los datos dividiendo cada pacial por el tiempo total, que dará una especie de “porcentaje” de cuánto tardan en cada parcial:

free800WomensNormalizado <- free800WomensPre %>%
  mutate(across(c(`50`, `100`, `150`, `200`, `250`, `300`, `350`, `400`, `450`, 
                  `500`, `550`, `600`, `650`, `700`, `750`, `800`), 
                ~ . / swimtime))

#free800WomensNormalizado$swimtime=NULL
free800WomensNormalizado <- as.data.frame(free800WomensNormalizado)
rownames(free800WomensNormalizado) <- free800WomensNormalizado$lastname

Bien, ahora, voy a tratar de hacer un cluster:

En primer lugar vamos a calcular la distancia Euclídea entre las observaciones de la base de datos.

distance <- get_dist(free800WomensNormalizado[,-c(1,2)])

fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

Esto empieza a ilustrar qué estados tienen grandes disimilitudes (rojo) frente a los que parecen ser bastante similares (verde azulado).

Veamos ahora, mediante el método de las siluetas, el número óptimo de clusters:

fviz_nbclust(free800WomensNormalizado[,-c(1,2)], kmeans, method = "silhouette")

A continuación, hacemos el cluster:

cluster800libres <- kmeans(free800WomensNormalizado[,-c(1,2)], centers = 3, nstart = 25)
cluster800libres
## K-means clustering with 3 clusters of sizes 12, 11, 20
## 
## Cluster means:
##           50        100        150        200        250        300        350
## 1 0.05675192 0.06133136 0.06150428 0.06214287 0.06190645 0.06241202 0.06255743
## 2 0.05629518 0.06163265 0.06200126 0.06269284 0.06254765 0.06309000 0.06335734
## 3 0.05837125 0.06233652 0.06282316 0.06277587 0.06267238 0.06278625 0.06299031
##          400        450        500        550        600        650        700
## 1 0.06308937 0.06303808 0.06354905 0.06351018 0.06403791 0.06392371 0.06411626
## 2 0.06379898 0.06347348 0.06386264 0.06364552 0.06390003 0.06354458 0.06353350
## 3 0.06284816 0.06295116 0.06283826 0.06316556 0.06308548 0.06331123 0.06317887
##          750        800
## 1 0.06399115 0.06213795
## 2 0.06266284 0.05996151
## 3 0.06306010 0.06080544
## 
## Clustering vector:
##        HOLOWCHAK     VAN DEN BERG          ASHWOOD            NEALE 
##                2                3                3                2 
##            EVANS             GILL          KOBRICH            ZHANG 
##                1                2                3                3 
##              CAO          TE FLAN ALVAREZ PUGLIESE           MORENO 
##                1                2                3                3 
##        ELHENICKA            FRIIS          AREVALO            COSTA 
##                1                1                3                1 
##            GOMEZ   RANNVAARDOTTIR           CARLIN        THIELMANN 
##                1                2                3                1 
##             BECK           KOHLER           GRUEST            KAPAS 
##                3                3                3                3 
##      CARAMIGNOLI            MUSSO               JO          DOUEIHY 
##                2                2                1                2 
##          HASSLER          OLIVIER             KHOO           ORTUNO 
##                3                2                3                1 
##   VAN ROUWENDAAL        CHENTSOVA         ROBINSON            BOYLE 
##                3                3                3                1 
##  MIYAHARA COELLO       SALAMATINA            TSENG             ODER 
##                2                1                2                3 
##          LEDECKY             MANN            PINTO 
##                1                3                3 
## 
## Within cluster sum of squares by cluster:
## [1] 8.126255e-05 5.106211e-05 6.589758e-05
##  (between_SS / total_SS =  43.1 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"
fviz_cluster(cluster800libres, data = free800WomensNormalizado[,-c(1,2)])

Bien, ahora para poder sacar las conclusiones debidas, voy a querer graficar el dataframe, donde cada nadadora (fila), va a tener asociado un cluster.

free800WomensNormalizado$cluster<-cluster800libres$cluster

A continuación, vuelvo al formato long, para ello:

prueba800long <- free800WomensNormalizado %>%
  pivot_longer(cols = c("50", "100", "150", "200", "250", "300", "350", 
                         "400", "450", "500", "550", "600", "650", 
                         "700", "750", "800"), 
               names_to = "splitdistance", 
               values_to = "splitswimtime")

Gráfica:

ggplot(prueba800long, aes(x = as.numeric(splitdistance), 
                          y = splitswimtime, 
                          group = lastname, 
                          color = factor(cluster))) +
  geom_line(alpha = 0.6) +  # Agrega líneas para cada nadadora
  geom_point() +             # Agrega puntos en cada parcial
  labs(x = "Parcial (m)", 
       y = "Tiempo de Nado (segundos)", 
       color = "Cluster") +
  theme_minimal() +
  ggtitle("Tiempos de Nado por Parciales Agrupados por Cluster")

Parece que este gráfico no es lo suficientemente claro, voy a evaluar nadadoras por cluster de manera separada:

# Filtrar datos por cluster y graficar
for (i in unique(prueba800long$cluster)) {
  p <- ggplot(prueba800long[prueba800long$cluster == i, ], 
               aes(x = as.numeric(splitdistance), 
                   y = splitswimtime, 
                   group = lastname, 
                   color = factor(cluster))) +
    geom_line(alpha = 0.6) + 
    geom_point() +
    labs(x = "Parcial (m)", 
         y = "Tiempo de Nado (segundos)", 
         color = "Cluster") +
    theme_minimal() +
    ggtitle(paste("Tiempos de Nado del Cluster", i))

  print(p)  # Imprime la gráfica
}

Para analizar mejor las estrategias, intentamos no fijarnos en el primer y último largo, ya que corresponden para todas las nadadoras, a largos en los que van más rápido. Tras ver las tres gráficas, se ve que, las nadadoras pertenecientes al cluster 1, son nadadoras que empiezan relativamente rápido pero que con el paso de los metros, empiezan a subir de tiempos cada parcial.

Las nadadoras del cluster 2, se aprecia que sus parciales tienen una forma de U invertida, empiezan rápido, sobre la mitad de la prueba, es donde más lento van, y luego vuelven a acelerar.

Las nadadoras del último cluster, observamos que son nadadoras muy constantes en cuanto a los parciales.

Vamos a evaluar estas 3 últimas gráficas graficando los centroides de cada cluster:

centroides <- as.data.frame(cluster800libres$centers)
centroides$cluster<- factor(rownames(centroides)) 
#Los vuelvo long: 
centroideslong <- centroides %>%
  pivot_longer(cols = c("50", "100", "150", "200", "250", "300", "350", 
                         "400", "450", "500", "550", "600", "650", 
                         "700", "750", "800"), 
               names_to = "splitdistance", 
               values_to = "splitswimtime")


# Gráfico
ggplot(centroideslong, aes(x = as.numeric(splitdistance), y = splitswimtime, color = cluster, group = cluster)) +
  geom_line(size = 1) +
  geom_point(size = 2) +
  scale_color_viridis_d() +  # Colores amigables para daltónicos
  labs(x = "Split Distance (m)", y = "Split Swim Time (s)", color = "Centroide") +
  theme_minimal()

Mejor cluster.

A continuación, vamos a evaluar cuál cluster tiene las mejores nadadoras, es decir, las nadadoras que pasaron a la final:

Vamos a ordenar el data frame free800WomensNormalizado:

free800WomensNormalizado <- free800WomensNormalizado[order(free800WomensNormalizado$swimtime), ]

finalistas<-head(free800WomensNormalizado, 8)

conteo <- table(finalistas$cluster)
conteo
## 
## 1 3 
## 3 5

Observamos que, hay nadadoras tanto del 3er cluster como del 1ro (5 y 3). Ahora, vamos a calcular la media de tiempos de cada cluster para ver “cuál” es el más rapido en media.

media_swimtime_por_cluster <- aggregate(free800WomensNormalizado$swimtime ~ free800WomensNormalizado$cluster, data = free800WomensNormalizado, FUN = mean, na.rm = TRUE)

media_swimtime_por_cluster
##   free800WomensNormalizado$cluster free800WomensNormalizado$swimtime
## 1                                1                          521.5200
## 2                                2                          544.9073
## 3                                3                          521.2725

IDEAS DE LOS PROFES

Graficar los centroides del kmeans para ver más claro cada tipo de estrategia. Además, intentar sacar conclusiones sobre los cluster, ¿cuál es el óptimo, es decir, en cuál están las mejores nadadoras?.

Mirar las gráficas e intentar ponerlas todas en colores para personas con daltonismo.

Poner en análisis de nacionalidades las paletas de los colores de los ¿juegos olímpicos? (son el mundial)

Sobre los test shapiro, cambiar e intentar hacer 3 cosas para ver si son normales:

  1. Probabilidad de que en mis datos, el reaction time sea mayor que 0.8?
  2. Calcular la media y la desviación típica y calcular la probabilidad como una Normal.
  3. Calcular la media y la desviación típica y calcular la probabilidad simulando los datos.

##Cluster 100 mariposa femenino [Javier]

Vamos a escalar los datos de prueba[,-1] (los relativos al PCA de 100 mariposa femenimo), es decir, restamos la media y dividimos por la desviación estándar, para que cada columna tenga media 0 y desviación estándar 1.

cluster100mariposafem <- scale(prueba[,-1])
cluster100mariposafem
##                reactiontime          50          100
## BORSHI           0.99461264  0.38573595  0.190955854
## NOBREGA          0.60245108  0.73027680  0.690792040
## MCKEON           0.99461264 -0.77230413 -0.866520704
## GROVES           0.60245108 -0.67659834 -0.869920950
## BAYRAMOVA        0.99461264  1.29494098  0.612586378
## BUYS             0.60245108 -0.89672166 -0.696508396
## KAJTAZ           0.40637031 -0.24113698  0.547981701
## RIBERA           0.40637031  0.64892688  1.173626996
## DE PAULA        -1.35835669 -0.63353073 -0.805316273
## DIAS            -0.77011436 -0.68616892 -0.373485010
## THOMAS          -1.75051824 -0.90629224 -0.693108150
## SAVARD          -0.96619513 -0.91586282 -0.818917258
## BUTLER           0.99461264  1.05567650  0.547981701
## URZUA            3.15150119  1.10352939  0.017543299
## CHEN             0.21028953 -0.63353073 -0.890322427
## LU               0.01420875 -0.91107753 -0.863120458
## CAMPOSANO RIOS  -0.77011436 -0.15500177 -0.523095841
## MEZA            -0.57403358 -0.19806938 -0.094664824
## BOS              1.97501652  2.19936071  1.887678691
## NEOFYTOU        -0.77011436  0.25653313  0.003942314
## SVECENA          0.40637031 -0.69573950 -0.227274425
## OTTESEN         -0.37795280 -0.96850100 -0.839318735
## OSMAN            0.40637031 -0.90150695 -0.652305196
## IGNACIO         -0.77011436 -0.36555451 -0.560498549
## PIKKARAINEN     -1.16227591 -0.52346907 -0.349683287
## WATTEL           0.60245108 -0.87279521 -0.550297811
## GASTALDELLO      0.40637031 -0.80101587 -0.526496088
## LOWE            -0.96619513 -0.62874544 -0.757712827
## KELLY           -0.37795280 -0.68138363 -0.808716519
## WENK            -0.77011436 -0.60003370 -1.012731289
## NTOUNTOUNAKI    -0.96619513 -0.65745718 -0.682907411
## SZE             -0.77011436 -0.49475733 -0.519695595
## VERRASZTO        0.01420875 -0.52825436 -0.710109381
## LORENZA          0.60245108  0.70156507  0.034544530
## GUSTAFSDOTTIR    0.60245108  0.03162452  0.027744038
## WATSON           0.01420875  0.66806804  0.687391794
## BIANCHI         -1.16227591 -0.81058645 -0.754312581
## DI LIDDO        -0.77011436 -0.65267189 -0.387085995
## PHILLIP         -0.96619513  1.08917352  1.374241520
## BAQLAH           0.79853186  0.07469213  0.609186132
## HOSHI           -1.55443747 -0.59046313 -0.876721443
## MUTETI           0.79853186  0.53886522  0.510578993
## AN              -0.57403358 -0.78187471 -0.818917258
## PARK            -1.35835669 -0.40383683 -0.577499780
## ARROYO          -0.18187203  0.17996850  0.177354869
## RODRIGUEZ       -1.16227591  0.24217727  0.061746499
## SONNENSCHEIN    -0.57403358  0.27088900  0.554782193
## TORREZ ZAMORA   -0.18187203  0.71592094  0.330365946
## DEKKER          -0.37795280 -1.17426846 -0.682907411
## ALKHALDI         0.60245108  0.06033626 -0.013058916
## MISECH          -0.18187203  2.44341048  2.265106015
## MCCARTHY         0.01420875  1.35236445  1.262033396
## MONTEIRO         0.21028953  0.08904800 -0.319081071
## CHOE             0.01420875  1.66340828  1.095421334
## ARKAJI           1.97501652  2.32856353  3.451791927
## LOVTCOVA         0.79853186 -0.78666000 -0.519695595
## POLIAKOVA        0.21028953 -0.69095421 -0.482292887
## UMURUNGI        -1.16227591  2.16586368  2.152897892
## PASSON           0.60245108  0.44315943  0.027744038
## QUAH            -0.37795280 -0.38469567 -0.400686979
## GOVEJSEK        -1.35835669 -0.82494232  0.167154130
## VILLARS         -0.18187203 -0.28898988 -0.839318735
## LISTOPADOVA      0.40637031 -0.60481899 -0.730510858
## SJOSTROM        -0.96619513 -1.09291853 -1.199744829
## PANUVE           0.40637031  2.42905461  3.101566572
## STEWART          0.79853186 -1.16469788 -0.608101996
## DONAHUE         -0.18187203 -1.00678332 -0.478892641
## PAEZ             0.21028953 -0.12629003 -0.489093380
## BA MATRAF        3.54366274  2.56782801  2.305908969
## attr(,"scaled:center")
## reactiontime           50          100 
##    0.7192754   28.8239130   33.4584058 
## attr(,"scaled:scale")
## reactiontime           50          100 
##   0.05099939   2.08973768   2.94096354

Ahora, calculamos y visualizamos la matriz de distancias entre las observaciones de cluster100mariposafem (REVISAR)

#Calulamos la matriz de distancias
distancias <- get_dist(cluster100mariposafem)
#Vemos la matriz de distancias como un mapa de calor
fviz_dist(distancias, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

Aquí: - low = “#00AFBB” (azul claro) representa las distancias pequeñas entre observaciones. - mid = “white” representa las distancias medias. - high = “#FC4E07” (rojo) representa las distancias grandes.

Aplicamos el algoritmo de las k-medias con k=2 con la función k-means, ejecutando el algoritmo 25 veces, por ejemplo

k100Mariposafemenino <- kmeans(cluster100mariposafem, centers = 2, nstart = 25)
k100Mariposafemenino
## K-means clustering with 2 clusters of sizes 48, 21
## 
## Cluster means:
##   reactiontime         50        100
## 1   -0.3207626 -0.5541747 -0.5068738
## 2    0.7331716  1.2666850  1.1585688
## 
## Clustering vector:
##         BORSHI        NOBREGA         MCKEON         GROVES      BAYRAMOVA 
##              2              2              1              1              2 
##           BUYS         KAJTAZ         RIBERA       DE PAULA           DIAS 
##              1              1              2              1              1 
##         THOMAS         SAVARD         BUTLER          URZUA           CHEN 
##              1              1              2              2              1 
##             LU CAMPOSANO RIOS           MEZA            BOS       NEOFYTOU 
##              1              1              1              2              1 
##        SVECENA        OTTESEN          OSMAN        IGNACIO    PIKKARAINEN 
##              1              1              1              1              1 
##         WATTEL    GASTALDELLO           LOWE          KELLY           WENK 
##              1              1              1              1              1 
##   NTOUNTOUNAKI            SZE      VERRASZTO        LORENZA  GUSTAFSDOTTIR 
##              1              1              1              2              1 
##         WATSON        BIANCHI       DI LIDDO        PHILLIP         BAQLAH 
##              2              1              1              2              2 
##          HOSHI         MUTETI             AN           PARK         ARROYO 
##              1              2              1              1              1 
##      RODRIGUEZ   SONNENSCHEIN  TORREZ ZAMORA         DEKKER       ALKHALDI 
##              1              1              2              1              1 
##         MISECH       MCCARTHY       MONTEIRO           CHOE         ARKAJI 
##              2              2              1              2              2 
##       LOVTCOVA      POLIAKOVA       UMURUNGI         PASSON           QUAH 
##              1              1              2              2              1 
##       GOVEJSEK        VILLARS    LISTOPADOVA       SJOSTROM         PANUVE 
##              1              1              1              1              2 
##        STEWART        DONAHUE           PAEZ      BA MATRAF 
##              1              1              1              2 
## 
## Within cluster sum of squares by cluster:
## [1] 38.7868 60.0305
##  (between_SS / total_SS =  51.6 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

La técnica aplicada genera 2 agrupaciones de 48 y 21 observaciones cada una. Además se especifica a qué conglomerado pertenece cada asignación (por ejemplo, Borshi pertenece al la agrupación 2, Nobrega a la 2, Mckeon a la 1…)

Ahora, visualicemos los resultados con fviz_cluster

fviz_cluster(k100Mariposafemenino, data =cluster100mariposafem)

Observamos gráficamente las dos agrupaciones mencionadas.

rm(cluster100mariposafem, k100Mariposafemenino, prueba, prueba100MariposaFem, distancias)
## Warning in rm(cluster100mariposafem, k100Mariposafemenino, prueba,
## prueba100MariposaFem, : objeto 'prueba100MariposaFem' no encontrado

Cluster 200 mariposa masculina

clusterprueba200 <- scale(pruebita[,-1])

summary(clusterprueba200)
##   reactiontime           edad               50               100          
##  Min.   :-2.00301   Min.   :-1.8998   Min.   :-1.0112   Min.   :-1.02533  
##  1st Qu.:-0.87190   1st Qu.:-0.6489   1st Qu.:-0.6775   1st Qu.:-0.57198  
##  Median : 0.07069   Median :-0.3362   Median :-0.2565   Median :-0.27085  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.63625   3rd Qu.: 0.6020   3rd Qu.: 0.3417   3rd Qu.: 0.06833  
##  Max.   : 1.95588   Max.   : 2.1656   Max.   : 3.4661   Max.   : 4.49427  
##       150                200         
##  Min.   :-0.95343   Min.   :-1.3190  
##  1st Qu.:-0.54698   1st Qu.:-0.7349  
##  Median :-0.27831   Median :-0.2088  
##  Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.07853   3rd Qu.: 0.4224  
##  Max.   : 4.76716   Max.   : 3.7891
distancias <- get_dist(clusterprueba200)
fviz_dist(distancias, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

k200 <- kmeans(clusterprueba200, centers = 2, nstart = 25)
str(k200)
## List of 9
##  $ cluster     : int [1:40] 1 1 1 1 2 1 1 1 1 1 ...
##  $ centers     : num [1:2, 1:6] -0.0633 1.2018 0.0671 -1.2744 -0.1638 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:2] "1" "2"
##   .. ..$ : chr [1:6] "reactiontime" "edad" "50" "100" ...
##  $ totss       : num 234
##  $ withinss    : num [1:2] 127.7 8.4
##  $ tot.withinss: num 136
##  $ betweenss   : num 97.9
##  $ size        : int [1:2] 38 2
##  $ iter        : int 1
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"
fviz_cluster(k200, data = clusterprueba200)

Como vemos, con 2 clusters nos divide a los participantes según el tiempo de reacción (vemos como el 5, que ya habiamos mencionado, aparece en los más rápidos). Los medios, son más, y están en el rojo.

Realmente parece que dos grupos no son suficientes. Vamos a verlo empíricamente.

# Reproducible
set.seed(123)

fviz_nbclust(clusterprueba200, kmeans, method = "wss")

Parece que deberiamos aumentar el número de grupos, incluso 5 grupos. A partir de 5 grupos, parece muy baja mejora.

Utilizamos otros métodos. Para ello, como el de la silueta.

fviz_nbclust(clusterprueba200, kmeans, method = "silhouette")

Parece que con dos grupos, podemos excluir a valores muy discriminados en nuestro estudio. Luego, depende de si nuestro objetivo es encontrar valores peculiares.

Probamos con k=5

k5_200 <- kmeans(clusterprueba200, centers = 5, nstart = 25)

fviz_cluster(k5_200, data = clusterprueba200)

El cluster 5 representa un grupo de nadadores que tienen un comportamiento peculiar en cuanto a los tiempos de reacción, y la edad no parece ser un factor determinante para ellos.

El grupo azul (cluster 4) tiene varias observaciones distribuidas más arriba a la derecha del gráfico, a lo largo de Dim1. Estos nadadores parecen tener una mayor edad y mayor tiempo de reacción. Esto tiene sentido, ya que el eje de Dim1 parece estar relacionado con el rendimiento en la prueba (donde mayor puntuación indicaría menor rendimiento).

Este cluster verde está ubicado hacia el centro del gráfico, alrededor del origen de los ejes de Dim1 y Dim2. Esto sugiere que los nadadores en este grupo tienen un rendimiento promedio o neutral en las variables consideradas (edad y tiempo de reacción).

Los puntos 5 y 26 están en un cluster aislado, probablemente por tener características atípicas en cuanto a su tiempo de reacción, pero con una edad no influyente. El cluster azul representa a nadadores mayores con tiempos de reacción más lentos, lo que afecta negativamente su rendimiento. Los otros clusters agrupan a los nadadores con características más cercanas entre sí en cuanto a edad y tiempos de reacción.

Cluster divisivo 200

# Clustering jerárquico divisivo
hc200 <- diana(clusterprueba200)

# Coeficiente de división; cantidad de estructura de agrupación encontrada
hc200$dc
## [1] 0.8769198

Podemos proceder a realizar el dendograma(cercano a 1).

# Drendrograma
pltree(hc200, cex = 0.6, hang = -1, main = "Dendrogram de DIANA")

Utilizamos k=5

# Método de Ward
# Matriz de disimilaridades
d200 <- dist(clusterprueba200, method = "euclidean")
hc5_200 <- hclust(d200, method = "ward.D2" )

# Cortamos en 4 clusters
sub_grp <- cutree(hc5_200, k = 5)

# Visualizamos el corte en el dendrograma
plot(hc5_200, cex = 0.6)
rect.hclust(hc5_200, k = 5, border = 2:5)

Veamos si coincide con los clusters anteriores

# Visualización
#Cluster realizado con el método de división
fviz_cluster(list(data=clusterprueba200,cluster=sub_grp))

#Cluster realizado con kmeans
fviz_cluster(k5_200, data = clusterprueba200)

Vemos que coinciden.

Cluster para la prueba de 1500 masculina

# escalado de todas las variables
clusterprueba1500 <- scale(prueba1500[,-1])

summary(clusterprueba1500)
##   reactiontime           50                100               150         
##  Min.   :-2.1160   Min.   :-1.41177   Min.   :-1.5004   Min.   :-1.3454  
##  1st Qu.:-0.7053   1st Qu.:-0.81993   1st Qu.:-0.8255   1st Qu.:-0.9183  
##  Median : 0.0000   Median :-0.04315   Median :-0.1946   Median :-0.1677  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.7053   3rd Qu.: 0.62266   3rd Qu.: 0.6416   3rd Qu.: 0.8548  
##  Max.   : 2.1160   Max.   : 2.50912   Max.   : 1.9914   Max.   : 2.0584  
##       200               250               300               350         
##  Min.   :-1.6590   Min.   :-1.2849   Min.   :-1.2325   Min.   :-1.2959  
##  1st Qu.:-0.8202   1st Qu.:-0.9045   1st Qu.:-0.8485   1st Qu.:-0.7896  
##  Median :-0.2610   Median :-0.2298   Median :-0.1767   Median :-0.1474  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.7736   3rd Qu.: 0.5799   3rd Qu.: 0.7693   3rd Qu.: 0.5566  
##  Max.   : 2.2975   Max.   : 2.4568   Max.   : 2.3735   Max.   : 2.6190  
##       400               450               500               550         
##  Min.   :-1.0932   Min.   :-1.2756   Min.   :-1.1910   Min.   :-1.3026  
##  1st Qu.:-0.8194   1st Qu.:-0.7749   1st Qu.:-0.7721   1st Qu.:-0.7589  
##  Median :-0.2221   Median :-0.3338   Median :-0.2814   Median :-0.2374  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.3380   3rd Qu.: 0.5484   3rd Qu.: 0.3170   3rd Qu.: 0.7944  
##  Max.   : 2.5532   Max.   : 2.3605   Max.   : 2.7107   Max.   : 2.5585  
##       600               650               700               750          
##  Min.   :-1.2170   Min.   :-1.3900   Min.   :-1.3771   Min.   :-1.70043  
##  1st Qu.:-0.7704   1st Qu.:-0.8979   1st Qu.:-0.7839   1st Qu.:-0.87398  
##  Median :-0.1711   Median :-0.1652   Median :-0.2363   Median :-0.03719  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.6046   3rd Qu.: 0.7971   3rd Qu.: 0.6422   3rd Qu.: 0.66530  
##  Max.   : 2.3087   Max.   : 2.3827   Max.   : 2.3306   Max.   : 2.29755  
##       800               850               900               950          
##  Min.   :-1.4187   Min.   :-1.5920   Min.   :-1.5837   Min.   :-1.53090  
##  1st Qu.:-0.8188   1st Qu.:-0.8359   1st Qu.:-0.7427   1st Qu.:-0.84231  
##  Median :-0.2075   Median :-0.2373   Median :-0.1748   Median :-0.05982  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.7320   3rd Qu.: 0.5713   3rd Qu.: 0.5898   3rd Qu.: 0.58704  
##  Max.   : 2.4751   Max.   : 2.2515   Max.   : 2.5558   Max.   : 2.43371  
##       1000              1050              1100               1150         
##  Min.   :-1.5166   Min.   :-1.4789   Min.   :-1.49527   Min.   :-1.84791  
##  1st Qu.:-0.8963   1st Qu.:-0.8732   1st Qu.:-0.78121   1st Qu.:-0.90869  
##  Median :-0.1889   Median :-0.1968   Median :-0.06715   Median :-0.02878  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.00000  
##  3rd Qu.: 0.8015   3rd Qu.: 0.7724   3rd Qu.: 0.57447   3rd Qu.: 0.73249  
##  Max.   : 2.4665   Max.   : 2.3877   Max.   : 2.49933   Max.   : 2.55162  
##       1200              1250              1300              1350         
##  Min.   :-1.5528   Min.   :-1.5302   Min.   :-1.5797   Min.   :-1.54941  
##  1st Qu.:-0.8311   1st Qu.:-0.8894   1st Qu.:-0.8333   1st Qu.:-0.87610  
##  Median :-0.1859   Median :-0.0712   Median :-0.1411   Median :-0.08885  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.6780   3rd Qu.: 0.5499   3rd Qu.: 0.7026   3rd Qu.: 0.79162  
##  Max.   : 2.7885   Max.   : 2.5905   Max.   : 2.3250   Max.   : 2.82190  
##       1400              1450              1500         
##  Min.   :-1.4540   Min.   :-2.0624   Min.   :-1.69280  
##  1st Qu.:-0.7646   1st Qu.:-0.6521   1st Qu.:-0.80255  
##  Median :-0.1290   Median :-0.1245   Median : 0.01065  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.6035   3rd Qu.: 0.5046   3rd Qu.: 0.66122  
##  Max.   : 2.7365   Max.   : 2.6556   Max.   : 2.68139
distance <- get_dist(clusterprueba1500)
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

k2 <- kmeans(clusterprueba1500, centers = 2, nstart = 25)
str(k2)
## List of 9
##  $ cluster     : Named int [1:45] 1 2 2 1 2 2 1 1 2 2 ...
##   ..- attr(*, "names")= chr [1:45] "ARIAS DOURDET" "NAIDICH" "HORTON" "AUBOCK" ...
##  $ centers     : num [1:2, 1:31] -0.2547 0.0926 0.9494 -0.3452 1.0842 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:2] "1" "2"
##   .. ..$ : chr [1:31] "reactiontime" "50" "100" "150" ...
##  $ totss       : num 1364
##  $ withinss    : num [1:2] 185 424
##  $ tot.withinss: num 608
##  $ betweenss   : num 756
##  $ size        : int [1:2] 12 33
##  $ iter        : int 1
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"
fviz_cluster(k2, data = clusterprueba1500)

Como vemos, con 2 clusters nos divide a los participantes según la velocidad. Es decir, los que pertenecen al cluster rojo serían los de tiempos más altos, y los azules los que están en mejores posiciones de resultados.

Nos preguntamos, si el número óptimo de clústeres para dividir a nuestro grupo total es realmente 2, o podemos dividirlos en más grupos. Para ello, utilizamos el método del codo.

# Reproducible
set.seed(123)

fviz_nbclust(clusterprueba1500, kmeans, method = "wss")

Parece que sí que tenemos una mejoría si continuamos diviendo nuestro grupo en 3 o incluso 4. Por encima de estos números, no obtenemos grandes mejoras en nuestro análisis.

Por tanto, probamos con k=3 y k=4 y observamos los resultados

k3 <- kmeans(clusterprueba1500, centers = 3, nstart = 25)

fviz_cluster(k3, data = clusterprueba1500)

k4 <- kmeans(clusterprueba1500, centers = 4, nstart = 25)

fviz_cluster(k4, data = clusterprueba1500)

Como podemos observar en ambos gráficos, la segregación de nadadores sigue estando bastante influida por su posición relativa al eje x. Es decir, nos clasifica los grupos según sus velocidades. Con 3 clústeres, tendríamos los nadadores lentos, los intermedios, y los muy rápidos. En el segundo gráfico con 4 clusteres, podemos observar los grupos muy lentos (prácticamente valores outiers), los centrales divididos en mas y menos lentos y un último grupo, de competidores de alta calificación. Observando ambos, los dos grupos de la derecha contienen prácticamente los mismos puntos. Sin embargo,si que existe una división entre los puntos de la izquierda. La elección de k=3 o k=4 vendrá por el interés del estudio que queramos realizar. Si no nos interesan los nadadores de peor cualificación, no será necesario segregar a los nadadores en 4 grupos. Sin embargo, si queremos analizar estos nadadores con peores marcas parece interesante ajustarnos a un nivel de k=4.

Utilizamos otros métodos para decidir si nuestro razonamiento es correcto. Para ello, utilizamos el método de “silueta” y el método “GAP”.

fviz_nbclust(clusterprueba1500, kmeans, method = "silhouette")

set.seed(123)
gap_stat <- clusGap(clusterprueba1500, FUN = kmeans, nstart = 25,
                    K.max = 10, B = 50)

print(gap_stat, method = "firstmax")
## Clustering Gap statistic ["clusGap"] from call:
## clusGap(x = clusterprueba1500, FUNcluster = kmeans, K.max = 10, B = 50, nstart = 25)
## B=50 simulated reference sets, k = 1..10; spaceH0="scaledPCA"
##  --> Number of clusters (method 'firstmax'): 1
##           logW   E.logW       gap     SE.sim
##  [1,] 4.336245 4.493474 0.1572291 0.04288661
##  [2,] 3.976479 4.098426 0.1219465 0.03239119
##  [3,] 3.728591 3.937819 0.2092281 0.02861930
##  [4,] 3.609006 3.845124 0.2361181 0.02697608
##  [5,] 3.495268 3.772875 0.2776070 0.02590680
##  [6,] 3.420334 3.705475 0.2851412 0.02633543
##  [7,] 3.354206 3.644346 0.2901399 0.02668787
##  [8,] 3.288867 3.589211 0.3003447 0.02683241
##  [9,] 3.234254 3.535993 0.3017387 0.02717407
## [10,] 3.179885 3.484878 0.3049935 0.02740995
fviz_gap_stat(gap_stat)

Utilizando estos dos últimos métodos, nos dan el resultado de que el número óptimo de clústers son dos en “silueta” y uno en “Gap”. Puesto que cada método nos determina un número distinto de k, utilizaremos la división en grupos según el objetivo a tratar, como hemos comentado recientemente.

##Cluster jerarquico prueba de 1500 metros masculina

Cluster aglomerativo. AGNES.

Queremos hacer un cluster jerárquico de nuestra prueba. Para ello, calculamos el valor del coeficiente aglomerativo

# Clustering jerárquico usando enlace completo
hc2 <- agnes(clusterprueba1500, method = "complete" )

hc2$ac
## [1] 0.877307

El coeficiente aglomerativo tiene un valor cercano al 1, con lo que sugiere una fuerte estructura de agrupamiento. Vamos ahora a evaluar qué metodo nos da un coeficiente mayor y emplearemos esa estructura de agrupacion con el objetivo de conseguir una estructura de agrupación más fuerte.

# Métodos evaluados
m <- c( "average", "single", "complete", "ward")
names(m) <- c( "average", "single", "complete", "ward")

# Función para calcular el coeficiente de agrupamiento
ac <- function(x) {
  agnes(clusterprueba1500, method = x)$ac
}

map_dbl(m, ac)
##   average    single  complete      ward 
## 0.7624746 0.4121959 0.8773070 0.9353093

Como vemos, lo conseguimos con el método ward. Por tanto, utilizamos ese método para realizar el dendrograma

# Matriz de disimilaridades
d <- dist(clusterprueba1500, method = "euclidean")

# Clustering jerárquico usando enlace completo
hc1 <- hclust(d, method = "ward" )
## The "ward" method has been renamed to "ward.D"; note new "ward.D2"
# Dendrograma
plot(hc1, cex = 0.6, hang = -1)

Interpretando el dendrograma, vemos como los primeros pasos de agrupamiento son entre distintas muy pequeñas. Por tanto, no tiene sentido cortar en esas etapas iniciales. El gráfico parece sugerir la aglomeración en 3 grupos.

##Cluster divisivo. DIANA.

Calculamos ahora el coeficiente de división.

# Clustering jerárquico divisivo
hc4 <- diana(clusterprueba1500)

# Coeficiente de división; cantidad de estructura de agrupación encontrada
hc4$dc
## [1] 0.8745697

Como podemos ver, tenemos un coeficiente de división cercano al 1. Con lo cual, podemos proceder a realizar el dendograma.

# Drendrograma
pltree(hc4, cex = 0.6, hang = -1, main = "Dendrogram de DIANA")

Utilizamos ahora la función “cutree” para dividir nuestro dendrograma en los clústers que consideremos. En este caso, utilizamos k=4

# Método de Ward
hc5 <- hclust(d, method = "ward.D2" )

# Cortamos en 4 clusters
sub_grp <- cutree(hc5, k = 4)

# Visualizamos el corte en el dendrograma
plot(hc5, cex = 0.6)
rect.hclust(hc5, k = 4, border = 2:5)

Veamos si coincide con los clusters que hemos considerado en el apartado previo

# Visualización
#Cluster realizado con el método de división
fviz_cluster(list(data=clusterprueba1500,cluster=sub_grp))

#Cluster realizado con kmeans
fviz_cluster(k4, data = clusterprueba1500)

Como vemos, las divisiones son similares, pero no son iguales. Esto se debe al método de agregación que difiere en ambos casos.

A su vez, comparamos si los dendrogramas utilizados para agregar o dividir son isomorfos.

# Matriz de distancias
res.dist <- dist(clusterprueba1500, method = "euclidean")

# Calcuamos los dos clustering jerárquicos
hc1 <- hclust(res.dist, method = "ward")
## The "ward" method has been renamed to "ward.D"; note new "ward.D2"
hc2 <- hclust(res.dist, method = "ward.D2")

# Dendrogramas
dend1 <- as.dendrogram (hc1)
dend2 <- as.dendrogram (hc2)

# los enfrentamos
tanglegram(dend1, dend2)

Como podemos observar, no nos dan dendrogramas isomorfos puesto que los dos métodos manejan de manera diferente las distancias entre grupos durante el proceso de fusión.

rm(clusterprueba1500, clusterprueba200, datos1500Masc, dend1, dend2, hc1, hc2, hc200, hc4, hc5, hc5_200, k2, k200, k3, k4, k5_200, pca_1500masculino, prueba1500, prueba200MariposaMasc, pruebita, d, d200, distance, distancias, ac, sub_grp, res.dist, m)
rm(centroides, centroideslong, cluster800libres, componentess, finalistas, free800WomensNormalizado, free800WomensPre, gap_stat, media_swimtime_por_cluster, auto, conteo, p, prueba200MariposaMasc2, prueba800libresPreliminar, prueba800long, R, i, Cor_CompVar, Cor_CompVar_retenidos)

Medidas de rendimiento.

#Voy a cargar aquí los datos para no tener que ejecutar todos los chunks anteriores:

datos2015<-read.csv("datos/2015_FINA.csv", header=TRUE, sep = ',')

datos2015<- datos2015 %>% convert_as_factor(gender,name,code,round,heat,lane,stroke, relaycount)

datos2015$relaycount <- NULL

datos2015<-datos2015 %>%
  filter(!(is.na(datos2015$points) & is.na(datos2015$reactiontime) & is.na(datos2015$swimtime) & is.na(datos2015$cumswimtime) & is.na(datos2015$splitswimtime)))


datos2015$birthdate <- as.Date(datos2015$birthdate)
#Calculamos la edad
fechaKazan<- as.Date("2015-07-24")
datos2015$edad <- as.numeric(difftime(fechaKazan, datos2015$birthdate, units = "weeks")) %/% 52  # Convertir de semanas a años

datos2015$birthdate<-NULL

nadadoresParticipantes <- datos2015 %>%
  distinct(athleteid, .keep_all = TRUE)

#guardamos una copia de seguridad por si se modifica el dataframe más adelante. 

nadadoresParticipantesCopia<-nadadoresParticipantes


nadadoresPruebas <- datos2015 %>%
  distinct(eventid, athleteid, .keep_all = TRUE)


#Copia de seguridad: 
nadadoresPruebasCopia<-nadadoresPruebas

A partir de este momento, vamos a estudiar acerca de un target. En este caso, nuestro target, ver si los finalistas van a mejorar su tiempo respecto a la ronda anteriormente nadada. Por lo que, vamos a quedarnos con el conjunto de nadadores que están clasificados a la final de cada prueba, y su tiempo en la ronda anterior. Para ello, voy a ir dividiendo los datos por cada distancia. Elegiré los nadadores que nadaron la final y la semifinal. Pero filtrando los semifinalistas

#Me quedo con los finalistas de las pruebas de 50, 100 y 200:
finalistas1<-datos2015[datos2015$round=="FIN" & datos2015$distance %in% c(50,100,200),]

condicionFiltro<-unique(finalistas1[,c("athleteid", "distance", "stroke")])

#Me quedo con los semifinalistas de las pruebas de 50, 100 y 200: 
semifinalistas1<-datos2015[datos2015$round=="SEM" & datos2015$distance %in% c(50,100,200),]

#Ahora, los filtro para que cumplan esa condición de Filtro.
semifinalistasFiltrados <- merge(semifinalistas1, condicionFiltro, by = c("athleteid", "distance", "stroke"))

#Ahora, hago la unión.

dataframe1 <- rbind(finalistas1, semifinalistasFiltrados)


#Ahora, hago el mismo proceso para las pruebas de 400, 800 y 1500 pero con las finales y preliminares: 

finalistas2<-datos2015[datos2015$round=="FIN" & datos2015$distance %in% c(400,800,1500),]
condicionFiltro<-unique(finalistas2[,c("athleteid", "distance", "stroke")])

semifinalistas2<-datos2015[datos2015$round=="PRE" & datos2015$distance %in% c(400,800,1500),]

#Ahora, los filtro para que cumplan esa condición de Filtro.
semifinalistasFiltrados2 <- merge(semifinalistas2, condicionFiltro, by = c("athleteid", "distance", "stroke"))

#Ahora, hago la unión.

dataframe2 <- rbind(finalistas2, semifinalistasFiltrados2)


#Ahora, hago la unión de mis datos: 

datos2015Target<-rbind(dataframe1, dataframe2)


#Los voy a ordenar por prueba y nombre. 

datos2015Target<-datos2015Target[order(datos2015Target$stroke, datos2015Target$athleteid, datos2015Target$distance), ]


rownames(datos2015Target)<-NULL
rm(condicionFiltro, dataframe1, dataframe2, finalistas1, finalistas2, semifinalistas1, semifinalistas2, semifinalistasFiltrados, semifinalistasFiltrados2)

Vamos a calcular la media, desviación típica, mínimo y máximo de cada parcial:

#hacemos un long to wide.

datos2015Target$split<-NULL
datos2015Target$cumswimtime<-NULL

datos2015TargetLong <- datos2015Target %>%
  pivot_wider(names_from = splitdistance,       # Los valores de 'Split' serán los nombres de las columnas
              values_from =splitswimtime)     # Los valores de 'Tiempo' llenarán las celdas

#Una vez hecho, vamos a calcular la media, desviación típica, mínimo y máximo de cada parcial.


datos2015TargetLong$mediaParciales<- rowMeans(datos2015TargetLong[, c("50", "100", "150", "200", "250", "300", "350", "400", "450", "500", "550", "600", "650", "700", "750", "800", "850", "900", "950", "1000", "1050", "1100", "1150", "1200", "1250", "1300", "1350", "1400", "1450", "1500")], na.rm=TRUE)

datos2015TargetLong$minimoParciales<- apply(datos2015TargetLong[, c("50", "100", "150", "200", "250", "300", "350", "400", "450", "500", "550", "600", "650", "700", "750", "800", "850", "900", "950", "1000", "1050", "1100", "1150", "1200", "1250", "1300", "1350", "1400", "1450", "1500")], 1, min, na.rm=TRUE)

datos2015TargetLong$maximoParciales<- apply(datos2015TargetLong[, c("50", "100", "150", "200", "250", "300", "350", "400", "450", "500", "550", "600", "650", "700", "750", "800", "850", "900", "950", "1000", "1050", "1100", "1150", "1200", "1250", "1300", "1350", "1400", "1450", "1500")], 1, max, na.rm=TRUE)


datos2015TargetLong$sdParcial<- apply(datos2015TargetLong[, c("50", "100", "150", "200", "250", "300", "350", "400", "450", "500", "550", "600", "650", "700", "750", "800", "850", "900", "950", "1000", "1050", "1100", "1150", "1200", "1250", "1300", "1350", "1400", "1450", "1500")], 1, sd, na.rm=TRUE)

datos2015TargetLong$medianaParciales<- apply(datos2015TargetLong[, c("50", "100", "150", "200", "250", "300", "350", "400", "450", "500", "550", "600", "650", "700", "750", "800", "850", "900", "950", "1000", "1050", "1100", "1150", "1200", "1250", "1300", "1350", "1400", "1450", "1500")], 1, median, na.rm=TRUE)

datos2015TargetLong[, c("50", "100", "150", "200", "250", "300", "350", "400", "450", "500", "550", "600", "650", "700", "750", "800", "850", "900", "950", "1000", "1050", "1100", "1150", "1200", "1250", "1300", "1350", "1400", "1450", "1500")]<-NULL


View(datos2015TargetLong)

rm(datos2015Target)

Ahora, busco que, para cada nadador que nada la final en una prueba de una distancia determinada, en sus columnas aparezcan las variables de las finales y las semifinales a la vez. Para ello: Voy a dividir el dataframe datos2015TargetLong en 2, uno con los finalistas y otro con los semifinalistas.

dataframe1<-datos2015TargetLong[datos2015TargetLong$round=="FIN", ]
dataframe2<-datos2015TargetLong[datos2015TargetLong$round == "PRE" | datos2015TargetLong$round== "SEM", ]

#Voy a cambiar los nombres de las variables para que, al hacer el merge, se puedan ver las variables de manera intuitiva.

dataframe1 <- dataframe1 %>%
  rename(
    eventidF= eventid,
    heatF= heat,
    laneF= lane,
    pointF= points,
    reactiontimeF= reactiontime,
    swimtimeF = swimtime,
    daytimeF= daytime,
    mediaParcialesF= mediaParciales,
    minimoParcialesF= minimoParciales,
    maximoParcialesF= maximoParciales,
    sdParcialF= sdParcial,
    medianaParcialesF= medianaParciales
  )

dataframe2<- dataframe2%>%
  rename(
    eventidP= eventid,
    heatP= heat,
    laneP= lane,
    pointP= points,
    reactiontimeP= reactiontime,
    swimtimeP = swimtime,
    daytimeP= daytime,
    mediaParcialesP= mediaParciales,
    minimoParcialesP= minimoParciales,
    maximoParcialesP= maximoParciales,
    sdParcialP= sdParcial,
    medianaParcialesP= medianaParciales
  )
#Ahora, quiero hacer un join por athleteid, distance, stroke: 

datos2015Target <- merge(dataframe1, dataframe2, by = c("athleteid", "distance", "stroke"), all = FALSE)

# Eliminar una o varias columnas
datos2015Target <- datos2015Target %>% select(-round.x, -lastname.y, -firstname.y, -gender.y, -name.y, -code.y, -round.y, -edad.y)

#Renombro aquellas que tienen el .x o .y:

datos2015Target<- datos2015Target%>%
  rename(
    lastname= lastname.x,
    firstname= firstname.x,
    gender= gender.x,
    name= name.x,
    code= code.x,
    edad= edad.x
  )
rm(dataframe1, dataframe2, datos2015TargetLong )

Bien, me falta ahora, añadir el target:

# Crear la nueva variable target según la condición
datos2015Target$target <- ifelse(datos2015Target$swimtimeF - datos2015Target$swimtimeP < 0, 1, 0)

Si visualizo al primer nadador:

head(datos2015Target,1)
##   athleteid distance stroke  lastname    firstname gender      name code
## 1    100403      100    FLY SCHOOLING JOSEPH ISAAC      M Singapore  SIN
##   eventidF heatF laneF pointF reactiontimeF swimtimeF daytimeF edad
## 1      130     1     1    934           0.6     50.96     1813   20
##   mediaParcialesF minimoParcialesF maximoParcialesF sdParcialF
## 1           25.48            23.53            27.43   2.757716
##   medianaParcialesF eventidP heatP laneP pointP reactiontimeP swimtimeP
## 1             25.48      230     2     3    910           0.6      51.4
##   daytimeP mediaParcialesP minimoParcialesP maximoParcialesP sdParcialP
## 1     1835            25.7            23.83            27.57   2.644579
##   medianaParcialesP target
## 1              25.7      1

Observo que Joseph Schooling, nadó la final más rapido que la final, por lo que tienen de target un 1.

Partición de los datos.

La repartición de nuestros datos, será sobre las finales. En total, tengo 8 nadadores por cada final, 2 sexos. En las pruebas de 50 y 100 tengo 4 estilos, lo que suma 128 nadadores. También, tengo en las pruebas de 200, 8 nadadores, 2 sexos y 5 estilos, lo que suma 80. En el 400 tengo 8 nadadores, 2 sexos y 2 estilos, lo que suma 32 nadadores. En el 800 y 1500 tengo 8 nadadores por cada sexo, lo que hace un total de 32 nadadores.

La suma total es de 272 nadadores, aunque debemos tener en cuenta que hubo una baja en la final del 1500 masculino, luego será de 271 nadadores.

Vamos a ver si estas cuentas son ciertas de la siguiente manera:

nadadoresFinalistas<-nadadoresPruebas[nadadoresPruebas$round=="FIN", ]
rownames(nadadoresFinalistas) <- 1:nrow(nadadoresFinalistas)
dim(nadadoresFinalistas)
## [1] 271  21

Luego, observamos que sí, estamos en lo cierto. Ahora, voy a hacer la repartición de mis datos sobre el dataframe creado anteriormente:

n=nrow(datos2015Target)
set.seed(1312)
indices_validation= sample(1:n, n*0.1)
indices_entrenamiento= c(1:n)[-indices_validation]

#he dividido los datos, ahora, cojo los de entreno y divido otra vez. 
n_entrenamiento=length(indices_entrenamiento)
set.seed(2910)
indices_train=sample(indices_entrenamiento, 0.8*n_entrenamiento)
indices_test=c(1:n)[-c(indices_validation, indices_train)]
#reinicio las filas por si acaso:
rownames(datos2015Target) <- NULL
#hago la repartición:
datos2015Target_train=datos2015Target[indices_train,]
datos2015Target_test= datos2015Target[indices_test, ]
datos2015Target_validation=datos2015Target[indices_validation, ]